10 REM Letter Head Designer
   20 REM Version 1.10
   30 REM By Piers Wilson
   40 REM Watch out for version 2.00 ...
   50 REM ... Coming soon !
   60 :
   70 MODE4
   80 *FX229,1
   90 VDU19,0,4;0;19,1,7;0;23,1,0;0;0;0;
  100 PROCinit
  110 PRINTTAB(0,6);STRING$(40,CHR$224)
  120 VDU5:MOVE0,31:PRINTSTRING$(40,CHR$224):MOVE0,0:VDU4
  130 REPEAT
  140  M%=FNmenu
  150  IF M%=6 IF FNask("Are you sure (Y/N)","Y","N")=1 THEN PROCwindow(1):END
  160  IF M%=1 PROCprint ELSE IF M%=2 PROCdesign ELSE IF M%=3 PROCsave ELSE IF M%=4 PROCload ELSE IF M%=5 PROCclear
  170 UNTIL 0
  180 :
  190 DEFPROCinit
  200 VDU23,224,0,0,255,&AA,&55,255,0,0
  210 VDU23,225,0,96,96,0,0,0,0,0
  220 VDU23,226,240,144,144,240,0,0,0,0
  230 VDU23,227,128,128,128,128,128,128,128,128
  240 VDU23,228,1,1,1,1,1,1,1,1
  250 VDU23,229,8,28,62,127,8,8,8,0
  260 ENDPROC
  270 :
  280 DEFPROCwindow(fc%)
  290 VDU28,0,30,39,7
  300 IF fc%=0 THEN bc%=1 ELSE fc%=1:bc%=0
  310 COLOUR128+bc%:COLOURfc%:CLS
  320 ENDPROC
  330 :
  340 DEFPROCdouble(A$,xpos%,ypos%)
  350 FORI%=1 TO LENA$
  360 A%=&A:X%=&70:Y%=&00
  370 ?&70=ASC(MID$(A$,I%,1))
  380 CALL &FFF1
  390 VDU23,254,?&71,?&71,?&72,?&72,?&73,?&73,?&74,?&74
  400 VDU23,255,?&75,?&75,?&76,?&76,?&77,?&77,?&78,?&78
  410 PRINTTAB(xpos%+I%,ypos%)" "
  420 PRINTTAB(xpos%+I%,ypos%+1)CHR$254
  430 PRINTTAB(xpos%+I%,ypos%+2)CHR$255
  440 PRINTTAB(xpos%+I%,ypos%+3)" "
  450 NEXT
  460 ENDPROC
  470 :
  480 DEFFNmenu
  490 PROCwindow(0)
  500 COLOUR128:COLOUR1
  510 PROCdouble(" Letterhead Designer Menu ",6,1)
  520 COLOUR129:COLOUR0
  530 PRINTTAB(6,6)" 1..... Print Letterhead "TAB(6,8)" 2..... Edit Letterhead "TAB(6,10)" 3..... Save Letterhead "
  540 PRINTTAB(6,12)" 4..... Load Letterhead "TAB(6,14)" 5..... Clear Letterhead"TAB(6,16)" 6..... End the Program"
  550 COLOUR128:COLOUR1
  560 PROCdouble(" Enter your choice (1-6). ",6,19)
  570 REPEAT
  580 *FX15,1
  590 A=GET-48
  600 UNTIL A>0 AND A<7
  610 =A
  620 :
  630 DEFPROCzoom(left%)
  640 VDU5
  650 FOR row%=0 TO 191 STEP 4
  660 FOR col%=left% TO left%+320 STEP 4
  670 GCOL 0,POINT(col%,835+row%)
  680 MOVE (col%-left%)*4,47+(row%*4)
  690 VDU225
  700 GCOL3,1:PLOT69,col%,831+row%:PLOT69,col%,831+row%
  710 NEXT
  720 NEXT
  730 VDU4
  740 ENDPROC
  750 :
  760 DEFPROCedit(orig%)
  770 GCOL4,1
  780 MOVE 0,799:VDU5,226,4
  790 a%=0:b%=799:aa%=orig%:bb%=1023
  800 REPEAT
  810 MOVE a%,b%:VDU5,226,4
  820 IF INKEY-98 AND a%>0 a%=a%-16:aa%=aa%-4
  830 IF INKEY-67 AND a%<1263 a%=a%+16:aa%=aa%+4
  840 IF INKEY-73 AND b%<799 b%=b%+16:bb%=bb%+4
  850 IF INKEY-105 AND b%>47 b%=b%-16:bb%=bb%-4
  860 MOVE a%,b%:VDU5,226,4
  870 IF INKEY-74 GCOL0,1:MOVE a%,b%:VDU5,225,4:PLOT69,aa%,bb%
  880 IF INKEY-90 GCOL0,0:MOVE a%,b%:VDU5,225,4:PLOT69,aa%,bb%
  890 GCOL4,1
  900 MOVE a%,b%:VDU5,226,4
  910 MOVE a%,b%:VDU5,226,4
  920 UNTIL INKEY-113
  930 ENDPROC
  940 :
  950 DEFFNask(Q$,A1$,A2$)
  960 PROCwindow(0)
  970 PROCdouble(Q$,(40-LENQ$)/2-1,8)
  980 *FX15,1
  990 REPEAT
 1000 *FX15,1
 1010 B$=GET$
 1020 *FX15,1
 1030 IF B$=A1$ THEN ans%=1 ELSE IF B$=A2$ ans%=2 ELSE ans%=0
 1040 UNTIL ans%<>0
 1050 =ans%
 1060 :
 1070 DEFFNcur
 1080 VDU26
 1090 cur%=0
 1100 REPEAT
 1110 cur%=cur%+(INKEY-98 AND cur%>0)-(INKEY-67 AND cur%<30)
 1120 IF cur%=30 cur$=STRING$(30,CHR$224)+A$:GOTO 1150
 1130 IF cur%=0 cur$=A$+STRING$(30,CHR$224):GOTO 1150
 1140 cur$=STRING$(cur%,CHR$224)+A$+STRING$(40-cur%-10,CHR$224)
 1150 PRINTTAB(0,6)cur$
 1160 UNTIL INKEY-74
 1170 =cur%
 1180 :
 1190 DEFPROCdesign
 1200 A$=CHR$227+STRING$(8," ")+CHR$228
 1210 CLS
 1220 PROCwindow(1):PROCdouble("Select area to edit ...",7,8)
 1230 st%=FNcur
 1240 PROCwindow(1)
 1250 VDU26:COLOUR1:COLOUR128:PRINTTAB(st%+1,6)"Thinking"
 1260 PROCzoom(st%*32)
 1270 GCOL0,1:VDU5:MOVE0,31:PRINTSTRING$(40,CHR$224):MOVE0,0:VDU4
 1280 VDU26:COLOUR1:COLOUR128:PRINTTAB(st%+1,6)"Editing";CHR$229
 1290 PROCedit(st%*32)
 1300 VDU26:COLOUR1:COLOUR128:PRINTTAB(st%+1,6)"        "
 1310 ENDPROC
 1320 :
 1330 DEFPROCsave
 1340 PROCwindow(0)
 1350 PROCdouble("Enter Filename :",6,8)
 1360 INPUTTAB(8,12)">"file$:file$=LEFT$(file$,10)
 1370 PROCwindow(1)
 1380 OSCLI"SAVE L."+LEFT$(file$,7)+" 5800 5F80"
 1390 PROCwindow(1):PROCdouble("Letter head saved",6,2)
 1400 PROCdouble("PRESS A KEY ...",8,8)
 1410 A=GET
 1420 ENDPROC
 1430 :
 1440 DEFPROCload
 1450 PROCwindow(0)
 1460 PROCdouble("Enter Filename :",6,8)
 1470 INPUTTAB(8,12)">"file$:file$=LEFT$(file$,10)
 1480 PROCwindow(1)
 1490 OSCLI"LOAD L."+LEFT$(file$,7)+" 5800"
 1500 ENDPROC
 1510 :
 1520 DEFPROCprint
 1530 line%=(FNask("Underline Letterhead (Y/N)","Y","N")=1)
 1540 PROCwindow(0)
 1550 COLOUR128:COLOUR1
 1560 PROCdouble("Press ""P"" to print",9,8)
 1570 REPEAT UNTIL (GET AND &DF)=80
 1580 PROCdouble(" Printing ...     ",9,8)
 1590 VDU2,1,10,1,10,1,10,1,27,1,65,1,8,3
 1600 FORy%=1023 TO 847 STEP -16
 1610 VDU2,1,27,1,90,1,128,1,7
 1620 FORx%=0 TO 1279 STEP 4
 1630 byte%=0
 1640 FORi%=7 TO 0 STEP -1
 1650 byte%=byte%+(POINT(x%,y%-((7-i%)*2))*2^i%)
 1660 NEXT
 1670 FORprint%=1 TO 6:VDU1,byte%:NEXT
 1680 NEXT x%
 1690 NEXT y%
 1700 VDU1,10,1,10,1,10
 1710 IF line% THEN PROCunder
 1720 VDU1,7,1,7,1,10,1,10
 1730 VDU3
 1740 ENDPROC
 1750 :
 1760 DEFPROCunder
 1770 VDU2,1,27,1,90,1,128,1,7:FOR under%=1 TO 100:VDU1,0:NEXT:FOR under%=100 TO 110:VDU1,16:NEXT:FOR under%=110 TO 1810:VDU1,18:NEXT:FOR under%=1810 TO 1820:VDU1,16:NEXT:FOR under%=1820 TO 1920:VDU1,0:NEXT
 1780 ENDPROC
 1790 :
 1800 DEFPROCclear
 1810 VDU28,0,5,39,0:COLOUR128:CLS:ENDPROC