Extension for LPT access on Windows 98/NT/XP/2k/XP, by '''ZP Engineering srl''' [http://www.zpeng.com]. The official page for their Tcl products is [http://www.zpeng.com/Articles/Section1/tcl.html].

This is a reference page for lpttcl; see also [Parallel port] for a more general introduction.

Download version '''3.0''' from [http://www.zpeng.com/files/lpttcl_v3.zip].

Download version '''1.0''' from [http://www.zpeng.com/files/lpttcl.zip].

11/21/2023: Found the 2 files (inpout.dll and lpttcl.dll) here:<<br>>
https://rdrr.io/github/EcoNum/econum/f/

12/9/2023: Example: [I2C bitbang with lpttcl]

----
'''Commands summary'''

 .... both versions....

 lpt_getba          returns base address of selected LPT 
 lpt_setba <addr>   selects LPT at base address <addr>

 lpt_rddata         returns LPT data register value 
 lpt_rdstat         returns LPT status register value 
 lpt_rdctrl              returns LPT control register value

 lpt_wrdata <val>   writes <val> to LPT data register 
 lpt_wrstat <val>   writes <val> to LPT status register 
 lpt_wrctrl <val>   writes <val> to LPT control register 


 ... only in version 3.0 ....
 
 lpt_rdreg <offset>        generic register read at (base_address + offset) 
 lpt_wrreg <offset> <val>  generic register write at (base_address + offset)

 lpt_setport <id>   selects LPT<id>, where <id> = 1,2,3,...; 
 lpt_getport        returns 1,2,....
 
 (lpt_getba returns -1 if lpt_setport points to a non-existing LPT)
 (lpt_setba now accepts a 32-bit value)
 
 ----

'''Basic startup code'''

 console show
 wm withdraw .
 load lpttcl

  set ver [package require lpttcl]

  puts [format "LPTTCL, version %s" $ver]
  puts         "---------------------"
  puts [format "Current port: LPT%d" [lpt_getport]]
  puts [format "Base address: 0x%08X" [lpt_getba]]
  puts " "
  
  puts [format "Data    register:          0x%02X" [lpt_rdreg 0]]
  puts [format "Status  register:          0x%02X" [lpt_rdreg 1]]
  puts [format "Control register:          0x%02X" [lpt_rdreg 2]]
  puts [format "Extended control register: 0x%02X" [lpt_rdreg 0x402]]

and its output on a console:

 LPTTCL, version 3.0
 ---------------------
 Current port: LPT1
 Base address: 0x00000378
  
 Data    register:          0xAA
 Status  register:          0x78
 Control register:          0x0C
 Extended control register: 0x15


'''Utilities'''

Note that in ver. 3.0 you can now perform a quick autoscan of available LPT ports:
  
  proc LPTscan {{nmax 8}} {
    for {set i 1} {$i < $nmax} {incr i} {
      lpt_setport $i
      if {[lpt_getba] == -1} {
         puts "LPT$i absent"
         } else {
         puts "LPT$i present"
         }       
    }
  }


We made some profiling of access speed (when you insert real code in the loop, it goes slower); note that the test is compatible with both versions.

  proc toggle {num} {
  for {set i 0} {$i < $num} {incr i} {
      lpt_wrdata 0x55
      lpt_wrdata 0xAA
      }
  }


  proc getmaxfreq {{ntimes 10000}} {
    set tt [time {toggle $ntimes}]
    scan $tt %i tt
    set mf [expr (2000 * $ntimes / $tt)] ;# 2 writes, expressed in kHz
    puts "Max frequency is $mf kHz"
  }


Some results (using freewrap 5.4, based on Tcl/tk 8.3.5) using '''getmaxfreq''':

   * laptop, P4 M 1.6 GHz, XP prof.: around 130 kHz
  
   * desktop, P4 2.4 GHz, XP prof.: around 210 kHz
  
The old version runs faster (around 2,5 times faster on some PCs!!); furthermore, newer tcl versions are slower. 
As an example, we measured that 8.3.5 (freewrap) is about 20% faster than  8.4.7 (activestate).

----

meh: Are there any plans for a Linux version of LPTTCL? If not, can anybody refer me to a page showing how to use applicable LPT pins as 'bits' (on/off state, on sends a small voltage, off sends none)
----
distatica: meh, if you are referring to individual pin access under Linux, check out the Parapin library located here: http://parapin.sourceforge.net/
If not, please delete this. 
----

dec: meh, I'm currently working on a package that gives access to the parallel port on Linux, Ubuntu 7.10 distribution, it makes use of the ppdev user space driver.
It seems to work OK so far. email me at derek dot philip at tesco dot net and I'll forward you the source.

'''Example'''

----

Sunday, December 10, 2023

Driving LCD with parallel port with Tcl

`
DB25        LCD

pin bit  signal pin
2    0   RS     4
3    1   RW     5
4    2   EN     6
5    3
6    4   DB4    11
7    5   DB5    12
8    6   DB6    13
9    7   DB7    14
18       GND    1
         +5V    2
         INT    3 pulldown
`
<<br>>
<<br>>
======tcl
###
console show

load lpttcl
set ver [package require lpttcl]

lpt_wrdata 0x00
puts [lpt_rdstat]
set val 0
lpt_rdstat


 # to LCD 4-bit mode
 #

 proc sendX {hexString} {
  foreach byte $hexString {
      lpt_wrdata $byte
      puts $byte
  }
 }

 proc send_data {byte} {
   global addr
   set byte [string range $byte end-1 end]
   puts "byte: $byte"
   foreach {n1 n2} [split $byte ""] break
   sendX [list 0x${n1}5 0x${n1}1 0x${n2}5 0x${n2}1]
 }

 proc send_cmd {byte} {
   global addr
   set byte [string range $byte end-1 end]
   puts "byte: $byte"
   foreach {n1 n2} [split $byte ""] break
   sendX [list 0x${n1}4 0x${n1}0 0x${n2}4 0x${n2}0]
 }


 #set addr 0x27
 set addr 0x4e
 
 # LCD Initialization for 4-BIT bus
 sendX [list 0x34 0x30]
 
 after 50

 # LCD Initialization for 4-BIT bus
 sendX [list 0x34 0x30 0x34 0x30 0x24 0x20 0x24 0x20]
 
 # 2 Line LCD, 5x10 character
 sendX [list 0xc4 0xc0]
 
 # 01 = Clear Display
 # sendX [list 0x04 0x00 0x14 0x10]
 send_cmd 01
 #                   ^    ^    ^    ^
 
 # 0C = Display Control,Display ON
 # sendX [list 0x04 0x00 0xc4 0xc0]
 send_cmd 0C
 
 
 # 06 = Entry Mode Set, Auto Increment of cursor position
 # sendX [list 0x04 0x00 0x64 0x60]
 send_cmd 06
 #send_cmd 1C; # 07+1C se queda en el mismo lugar siempre ocupando un solo espacio

 #
 foreach letter [split "01234567" ""] {
   binary scan $letter "H2" valor
   send_data $valor
   after 1000
 }

 send_cmd C0
 
 foreach letter [split "89ABCDEF" ""] {
   binary scan $letter "H2" valor
   send_data $valor
   after 1000
 }
 
 for {set i 1} {$i<8} {incr i} {
 send_cmd 18
 after 500
 }
 
 puts "*** DONE!"
======

[Category Printing] | [Category Windows]