PagePrint listing from QL World

QL Heaven has always been a fan of SNG's listings in QL World. At QL Heaven 2 programs have been used to print to a HP 840 via the serial port from a Q60 (no serial ports on the PCs here for QPC2). These have been, Ghostscript, and PagePrint (by SNG from QL World). One problem for QL Heaven has been the old style user interfaces they have. So here is PagePrint with a GD2 user interface and menu extension integrated to select files:

Here is the code :

1000 REMark PAGE_PRINT 1.5 by Simon Goodwin, 6th May 1993 Tweak by ME 2nd October 2009
1010 REMark Generates ASCII, Epson, HP PCL 3+, version 1.5
1020 REMark QL SuperBasic; uses PAN#0,0,115(SD.CURSEN)
1030 :
1040 REMark Turbo favours: IMPLICIT% i,j,k
1042 TURBO_objfil "ram1_PagePrint"
1044 TURBO_taskn  "PagePrint 09"
1046 TURBO_objdat 20
1048 TURBO_repfil
1050 TURBO_diags  'dis' : TURBO_struct 'str' : TURBO_model  '<'
1052 TURBO_optim  'br'  : TURBO_windo  0     : TURBO_locstr 'Crt'
1054 :
1056 dir$="Win1_"
1060 page_length%=70
1070 column_gap%=4
1080 tab_width%=8
1090 print_device$="par"
1095 :
1100 SETWINDOWS
1110 PREPARE
1120 USER_INTERFACE
1130 PRINT_PAGES
1140 STOP
1150 :
1160 DEFine FuNction CHOICES%
1170 min_height%=10 : max_height%=4000
1180 WINDOW 452,52,36+xpos%,18+ypos% : WM_PAPER $201 : CLS
1190 WINDOW 452,52,30+xpos%,15+ypos% : WM_BORDER 1,$400 : WM_PAPER $201 : CLS
1200 CSIZE 0,0 : AT 1,11 : CSIZE 2,1 : WM_INK $202
1210 PRINT "Qdos PAGE PRINTING Utility"
1220 REMark Make Italic Banner
1230 FOR j=1 TO 9 : WINDOW 350,2,80+xpos%,ypos%+(25+j*2) : PAN 10-j
1240 WINDOW 448,50,32+xpos%,16+ypos% : CSIZE 1,0 : AT 3,4
1250 PRINT "For QL World, Version 1.5 @ 1993 Simon N Goodwin"
1260 REMark Add shadow to main window
1270 WINDOW 452,132,36+xpos%,78+ypos% : WM_PAPER $201 : CLS
1280 WINDOW 452,132,30+xpos%,75+ypos% : WM_BORDER 1,$400 : WM_PAPER $201 : CLS
1290 file$=FILE_SELECT$("Select a File to Print","",dir$,"",9,10,90,)
1295 PRINT\"File to print is: ";file$
1300 IF file$="" : PRINT#0,"Cancelled." : PAUSE 100: STOP
1310 REMark Add FTEST or DEVICE_STATUS here
1320 REPeat get_width
1330   PRINT\"Column width (e.g. 40): ";
1340   cols_used%=POSINT(#1)
1350   IF cols_used%<1 OR cols_used%>127
1360     PRINT \"Please specify a width between 1 and 127."
1370   ELSE
1380     EXIT get_width
1390   END IF
1400 END REPeat get_width
1410 col_spacing%=cols_used% + column_gap%
1420 WINDOW #0,452,32,36+xpos%,218+ypos% : WM_PAPER#0,201 : CLS#0
1430 WINDOW #0,452,32,30+xpos%,215+ypos% : WM_BORDER #0,1,$400 : WM_PAPER #0,$201
1440 CLS#0 : WM_BORDER #0,4,$400 : WM_INK #0,$202 : CSIZE #0,1,0
1450 :
1460 CLS : WM_PAPER $205 : WM_INK $206 : CSIZE 2,0
1470 AT 1,3:PRINT " Printer        Lines    Columns "
1480 AT 2,3:PRINT " standard       /page     /page  "
1490 i=1 : WM_PAPER $20A : WM_INK $20B : SHOW_VER$
1500 WM_PAPER $201 : WM_INK $202 : FOR i=2 TO pages% : SHOW_VER$
1510 PRINT #0;"For best PAGE PRINT results, pick the ";
1520 PRINT #0;"version to suit ";
1530 WM_INK #0,$202 : PRINT #0;"your "; : WM_INK #0,$202
1540 PRINT #0;"eyes and printer. Press ENTER to use the menu. ";
1550 SURE_PAUSE : i=1
1560 REPeat choose
1570   CLS #0
1580   PRINT #0;" Use the verical arrows (  ) to choose a version."
1590   PRINT #0;" Press SPACE to confirm or ESC to return to BASIC."
1600   REPeat poll
1610     PAUSE : k=KEYROW(1)
1620     IF k=0 : NEXT poll
1630     IF (k && 128) AND i1640       SHOW_VER$ : i=i+1 : WM_PAPER $20A : WM_INK $20B
1650       SHOW_VER$ : WM_PAPER $201 :WM_INK $202
1660     END IF
1670     IF (k && 4) AND i>1
1680        SHOW_VER$ : i=i-1 : WM_PAPER $20A : WM_INK $20B
1690        SHOW_VER$ : WM_PAPER $201 : WM_INK $202
1700     END IF
1710     IF k && 64
1720       CLS #0
1730       PRINT  #0;"PAGE PRINT version " & i;
1740       PRINT #0;" selected - are you sure?";
1750       IF YEA_OR_NAY : EXIT choose : ELSE NEXT choose
1760     END IF
1770     IF (k && 8)
1780       CLS #0 : PRINT #0;" Cancelled." : STOP
1790     END IF
1800   END REPeat poll
1810 END REPeat choose
1820 CLS #0
1830 PRINT #0;"The default paper size is A4, with ";
1840 PRINT #0;page_length%;" lines per page."
1850 IF i>=epson%
1860   PRINT #0," Do you want to change this";
1870   IF YEA_OR_NAY
1880     REPeat get_length
1890       CLS #0 : PRINT #0;"Enter page length, in standard ";
1900       PRINT #0;'3.1mm or 1/6" lines ?'
1910       page_length%=POSINT(#0)
1920       IF page_length%max_height%
1930         PRINT #0;" Sorry, this software expects ";
1940         PRINT #0;min_height%;" to ";max_height%;" lines/page. "
1950         PRINT #0;"Press ENTER to try again or ESC to quit. ";
1960         SURE_PAUSE
1970       ELSE
1980         EXIT get_length
1990       END IF
2000     END REPeat get_length
2010   END IF
2020   REMark work out gap between pages
2030   blanks%=5 * (1+(i=4 OR i=5))
2040   temp%=(height%(i) + blanks%)/70 * page_length% - blanks%
2050   height%(i)=temp%
2060 ELSE
2070  blanks%=0 : REMark no explicit blank lines in HP mode
2080 END IF
2090 RETurn i
2100 END DEFine CHOICES%
2110 :
2120 DEFine PROCedure SHOW_VER$
2130 AT i+3,3 : PRINT title$(i);
2140 PRINT TO 20;height%(i) TO 29;
2150 PRINT (width%(i) + column_gap%) DIV col_spacing% TO 35
2160 END DEFine SHOW_VER$
2170 :
2180 DEFine FuNction YEA_OR_NAY
2190 LOCal k$(2)
2200 PRINT #0;" (Y/N) ";
2210 REPeat loop
2220   k$=INKEY$(#0,-1)
2230   IF k$=="y" OR k$=="n" : EXIT loop
2240 END REPeat loop
2250 PRINT #0;k$ : RETurn k$<>"n"
2260 END DEFine YEA_OR_NAY
2270 :
2280 DEFine PROCedure SURE_PAUSE
2290 PAN #0,0,115 : REMark turn cursor on
2300 REMark CURSEN#0
2310 PAUSE 5 : PAUSE 5 : PAUSE 5 : REMark lose key bounce
2320 IF INKEY$(#0,-1)=esc$ : PRINT #0\\"Escape pressed." : STOP
2330 END DEFine SURE_PAUSE
2340 :
2350 DEFine FuNction POSINT(channel%)
2360 LOCal k$(6)
2370 INPUT#channel%;k$
2380 IF "e" INSTR k$ OR k$="" THEN k$="0"
2390 IF k$<0 OR k$>32767 THEN k$=""
2400 RETurn "0" & k$
2410 END DEFine POSINT
2420 :
2430 DEFine PROCedure PREPARE
2440 LOCal i
2450 tab$=CHR$(9) : esc$=CHR$(27) : space$=CHR$(32)
2460 hpx$=esc$ & "&" : hpt$=esc$ & "(" : formfeed$=CHR$(12)
2470 print%=3
2480 disk%=4
2490 epson_init$=esc$ & "@" : REMark reset Epson to power-up state
2500 REMark LF -> CR/LF, Wrap at right margin if line overflows
2510 hp_init$=hpx$ & "s0C" & hpx$ & "k2G" & hpx$
2520 REMark  Use portrait A4 paper, PC*%) character set
2530 hp_init$=hp_init$ & "126a0ol2dl44p01l28F" & hpt$ & "(12U"
2540 LET spec_max%=32 : REMark length limit for page setup strings
2550 LET title_max%=12: REMark Limiting length of printer name
2560 LET pages%=7 : REMark Total number of formats
2570 LET epson%=3 : REMark First Epson variant
2580 REMark Aim to be ready for anything
2590 DIM width%(pages%),height%(pages%)
2600 DIM page_spec$(pages%,spec_max%),title$(pages%,title_max%)
2610 RESTORE 2740
2620 FOR i=1 TO pages%
2630   READ title$(i)
2640   READ temp$ : IF i2650   READ width%(i),height%(i)
2660 END FOR i
2670 REMark Control codes don't suit constant data
2680 page_spec$(3)=CHR$(15) & esc$ & "M"
2690 page_spec$(5)=CHR$(15) & esc$ & "3" & CHR$(18) & esc$ & "S0"
2700 page_spec$(4)=page_spec$(5) & esc$ & "M"
2710 page_spec$(6)=CHR$(15)
2720 END DEFine PREPARE
2730 :
2740 REMark Name, setup string, width, height in characters
2750 DATA "HP 1","s0p12h6v0s0b6t2Q",96,130
2760 DATA "HP 2","s0p24h6v0s0b6t2Q",192,130
2770 DATA "New Epson 1","",160,65
2780 DATA "New Epson 2","",160,110
2790 DATA "Old Epson","",132,110
2800 DATA "Condensed","",132,65
2810 DATA "Plain ASCII","",80,65
2820 :
2830 DEFine PROCedure USER_INTERFACE
2840 LOCal t%
2850 form%=CHOICES%
2860 REMark INPUT "File Name     : ";file$
2870 REMark INPUT "Column width  : ";cols_used%
2880 REMark INPUT "Format (1..7) : ";form%
2890 REMark blanks%=5*(1 + (form%=4 or form%=5))
2900 REMark col_spacing%=cols_used%+column_gap%
2910 IF form%2920   pr_init$=hp_init$
2930 ELSE
2940   pr_init$=epson_init$
2950 END IF
2960 page_size$=page_spec$(form%)
2970 t%=width%(form%) : REMark "JM" bodge
2980 DIM grid$(height%(form%),t%)
2990 BLANK_PAGE
3000 END DEFine USER_INTERFACE
3010 :
3020 DEFine PROCedure PRINT_PAGES
3030 PRINT_INIT
3040 page_count%=0 : row%=1 : col%=1
3050 PRINT_FILE
3060 IF row%+col%<>2 : PRINT_PAGE : REMark Do anything left
3070 CLOSE#print%
3080 CLS#0 : PRINT#0;page_count%; " page";
3090 IF page_count%<>1 : PRINT#0;"s";
3100 PRINT#0;" printed."
3110 END DEFine PRINT_PAGES
3120 :
3130 DEFine PROCedure PRINT_INIT
3140 OPEN#print%,print_device$
3150 PRINT#print%;pr_init$;
3160 PRINT#print%;page_size$;
3170 END DEFine PRINT_INIT
3180 :
3190 DEFine PROCedure PRINT_FILE
3200 OPEN_IN#disk%,file$
3210 REPeat add_line
3220   IF EOF(#disk%) : EXIT add_line
3230   INPUT #disk%;line$;
3240   EXPAND_TABS line$
3250   BUFFER line$
3260 END REPeat add_line
3270 CLOSE#disk%
3280 CLOSE#disk%
3290 END DEFine PRINT_FILE
3300 :
3310 REFERENCE line$ : REMark Turbo only
3320 DEFine PROCedure EXPAND_TABS(t$)
3330 LOCal t%,f$(tab_width%)
3340 REPeat look
3350   t%=tab$ INSTR t$
3360   IF t%= 0 OR t%=LEN(t$) : EXIT look
3370   f$=FILL$(space$,tab_width% - (t%-1) MOD tab_width%)
3380   t$=t$(1 TO t%-1) & f$ & t$(t%+1 TO )
3390 END REPeat look
3400 END DEFine EXPAND_TABS
3410 :
3420 DEFine PROCedure BUFFER(line$)
3430 grid$(row%,col% TO col%+cols_used%-1)=line$
3440 row%=row%+1
3450 IF row% > height%(form%)
3460   row%=1 : REMark back to top
3470   col%=col% + col_spacing%
3480   IF col%-1 > width%(form%)-cols_used%
3490     PRINT_PAGE
3500     col%=1
3510   END IF
3520 END IF
3530 END DEFine BUFFER
3540 :
3550 DEFine PROCedure PRINT_PAGE
3560 LOCal i
3570 FOR i=1 TO height%(form%)
3580    PRINT #print%;grid$(i,1 TO width%(form%))
3590 END FOR i
3600 IF form%3610   PRINT#print%;form_feed$;
3620 ELSE
3630   REMark Skip Perforation
3640   FOR i=1 TO blanks% : PRINT #print%
3650 END IF
3660 page_count%=page_count%+1
3670 BLANK_PAGE
3680 END DEFine PRINT_PAGE
3690 :
3700 DEFine PROCedure BLANK_PAGE
3710 LOCal j
3720 FOR j=1 TO height%(form%)
3730   grid$(j)=FILL$(space$,width%(form%))
3740 END FOR j
3750 END DEFine BLANK_PAGE
3760 :
3800 DEFine PROCedure SETWINDOWS
3810 errt=FOPEN(#0,'con_')
3820 errt=FOPEN(#1,'con_')
3830 wndo_wd%=512 : wndo_ht%=256
3840 xpos%=(SCR_XLIM(#0)-wndo_wd%)DIV 2 : ypos%=(SCR_YLIM(#0)-wndo_ht%) DIV 2
3850 OUTLN#0,wndo_wd%,wndo_ht%,xpos%,ypos%
3860 WM_PAPER#0,$201 : WM_INK#0,$202 : WM_BORDER#0,4,$400 : CLS#0
3870 END DEFine SETWINDOWS

Windraw_bas SBASIC tool

There are many editing tools for SBASIC. - QD and the editor built into SBASIC and accessed by the ED command being amongst the best. Some also like the Editor from DP. QD is amongst QL Heavens favourite programmes but there are times especially when typing in SBASIC listing that ED is preferable. Launching Windraw_bas as a daughter SBASIC job from Launchpad allows a movable reconfigurable set of SBASIC windows to configure for an SBASIC editing session using ED. Here is Windraw_bas and below some pictures of it in action. Credits to James Lucy and SA Hall and also QL Heaven for a tweak to this program.

100 REMark Move & Resize Basic's Windows

110 REMark James Lucy's program, much added to by S.A.Hall 04/06/97.

120 :

130 WDB0 = PEEK_L(PEEK_L(!!120))

140 xs=800:ys=400:xo=200:yo=68 : REMark my preferences for setup

150 :

160 errt=FOPEN(#0,con_)

170 errt=FOPEN(#1,con_):errt=FOPEN(#2,con_) : Get_pal 0

180 x% = SCR_XLIM(#0) :y% = SCR_YLIM(#0)        : REMark Get Screen Dims

190 setscreens:OUTLN#0,xs,ys,xo,yo

200 s=20                                        : REMark  speed to 10

210 POKE_W !!136,0                              : REMark caps lock off

220 REPeat draw_box

230   key=CODE(INKEY$(-1))                      : REMark Wait for key

240   m=1

250   SELect ON key

260    =102 : s=20                              : REMark "f" fast, moves in steps of 10

270    =115 : s=1                               : REMark "s" slow, moves in steps of 1

280    =208 : yo=yo-s : IF yo<0: yo=0           : REMark csr up

290    =216 : yo=yo+s : IF yo+ys>y%:yo=yo-s      : REMark csr down

300    =192:xo=xo-s:IF xo<0:xo=0                    : REMark csr left

310    =200:xo=xo+s: IF xo+xs>x%:xo=xo-s            : REMark csr right

320                                                REMark shift csr down

330    =220:ys=ys+s:m=0:IF ys+yo>y%:ys=y%-yo :m=0

340                                                REMark shift csr up

350    =212:ys=ys-s:m=0:IF ys<80:ys=80       :m=0

360                                                REMark shift csr right

370    =204:xs=xs+s:m=0:IF xs+xo>x%:xs=x%-xo :m=0

380                                                REMark shift csr left

390    =196:xs=xs-s:m=0:IF xs<160:xs=160     :m=0

400    =10: setscreens:CLS#0:CLS:CLS#2:NEW          : REMark Hit ; outline

410 END SELect

420 OUTLN#0,xs,ys,xo,yo:BORDER#0,1,Wbcol:CLS#0

430 IF m=1 :setscreens

440 IF s= 20 : a$='Fast':ELSE a$='Slow'

450 AT#0,0,1:PRINT#0, xs;'x';ys;' a ';xo;'x';yo;' ';:WM_INK#0,Wicol:PRINT#0,a$: OVER#0,-1

460 WM_INK#0,Wicol

470 END REPeat draw_box

480 :

490 DEFine PROCedure setscreens

500 xs12 = INT(xs*.5)                               : REMark Divide width &

510 xs2=INT(xs*.75)

520 ys12 = INT(ys*.8)                         : REMark Divide height to

530 ys0 = INT(ys*.2)                          : REMark keep it in scale

540 WINDOW#0,xs,ys0,xo,ys12+yo :WM_PAPER#0,Wpcol:INK#0,0:WM_BORDER#0,1,Wbcol

550 WINDOW xs,ys12,xo,yo:WM_PAPER Wpcol:WM_INK Wicol: WM_BORDER 1,Wbcol

560 WINDOW#2,xs2,ys12,xo,yo:WM_PAPER#2,Wpcol:WM_INK#2,Wicol:WM_BORDER#2,1,Wbcol:CSIZE#2,1,0

570 END DEFine

580 :

590 DEFine PROCedure Get_pal (syspal)

600 LOCal mem,num

610 REMark this is a general function to GET a system palette....

620   num = 57                  : REMark number of entries in palette

630   mem = ALCHP(num * 2)      : REMark mem needed for palette entries

640   SP_GET syspal,mem,0,57

650   Wpcol=PEEK_W (mem+23*2)    : REMark get palette entries in memory

660   Wicol=PEEK_W (mem+4)

670   Wbcol=PEEK_W (mem)         : REMark get palette entries in memory

680   CLCHP mem

690 END DEFine Get_pal

700 :

Plodding on with SBASIC listing typing and feelings of mortality

Typing in 3D noughts and crosses from the QL World is like watching paint dry. But it is still progressing. The finished listing will be published and then any tweaks needed to update it for modern QL systems. The QL world has been quietish since the last QL Today was published. Thinner and lighter than before. Feels a bit like the last days of QL World but at least QL Today is not published by the late Robert Maxwell. Nor is there an employees pension fund to dip into. On ebay last night there are now 4 pages of QL items for sale. QLs in good condition still seem to be going for around £100 (UK). I dont know if the increase in QL items means more interest in QLing or a rush to get out before the end. Time will tell but one thing is certain which is that the end of the QL has been predicted before time and again staring when sinclair launched the QL before it was ready and then a year or so later when sinclair sold out to Amstrad. These predictions and been wrong so far but unfortunately its a bit like the mafia hit - it just need to be on the money the once and then you are dead and out while the QL has to be lucky every time.

                          Anyway here is the latest QL Today cover :