Extension for LPT access on Windows 98/NT/XP/2k/XP, by ZP Engineering srl [L1 ]. The official page for their Tcl products is [L2 ].
This is a reference page for lpttcl; see also Parallel port for a more general introduction.
Download version 3.0 from [L3 ].
Download version 1.0 from [L4 ].
11/21/2023: Found the 2 files (inpout.dll and lpttcl.dll) here:
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:
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
https://openclipart.org/detail/308001/lcd-hd44780-pinout
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
###
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!"