home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u397.dms / in.adf / Forms.AMOS / Forms.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1990-10-01  |  33.4 KB  |  1,091 lines
  1. '           **************************************** 
  2. '           **      FORMS REALLY UNLIMITED        ** 
  3. '           **      ----------------------        ** 
  4. '           **       (c)  A.H.Meek 1990           ** 
  5. '           **            -------------           ** 
  6. '           **************************************** 
  7. '  
  8. Set Buffer 40
  9. '
  10. VERSION$="Ver:1.04" : Rem  ------------------------  Latest date 27/09/90  
  11. '            
  12. '------------------  Version History ------------------------------------
  13. '  1.00    Initial Appraisal Sample
  14. '  1.01    Box Drawing Procedures implemented correctly to overlap 
  15. '  1.02    Line Insertion and Deletion with Undo facility added
  16. '  1.03    Colour Changes to suit Introduction Screen - 2nd Sample       
  17. '  1.04    Printing Procedures corrected - Sent to P.D. 3rd Sample 
  18. '------------------------------------------------------------------------
  19. '
  20. Screen Open 1,640,264,8,Hires
  21. Screen Display 1,128,38,446,256
  22. Palette $0,$44,$FFC,FF0,$F0F,$BA7,$600,$F00
  23. '
  24. Global VERSION$,LINE$,SLINE$,XPOS,YPOS,SPOS,UPPER_LIMIT,CHANGE_FLAG
  25. Global ALT$,TLC$,TRC$,BLC$,BRC$,SCR_LIMIT,SCR_WIDTH
  26. Global FILENAME$,TEMP_NAME$,CX1,CX2,CY1,CY2,GX1,GX2,GY1,GY2
  27. '
  28. FILENAME$="noname"
  29. UPPER_LIMIT=50
  30. SCR_LIMIT=30
  31. SCR_WIDTH=80
  32. LINE$=Space$(UPPER_LIMIT*SCR_WIDTH)
  33. CHANGE_FLAG=0
  34. Cls 
  35. Limit Mouse 128,38 To 446,286
  36. '
  37. Curs Off 
  38. Reserve Zone 20
  39. Set Dir 30,".info/*.info/*.*.info/*.bak/*.*.bak/*.abk/*.*.abk"
  40. '
  41. INIT_MENU
  42. Menu On : On Menu On 
  43. On Menu Proc CH_OPT,CH_FLE,CH_INP,CH_PRT
  44. On Menu On : Show On 
  45. '
  46. '
  47. INIT_PARAMS
  48. INIT_LINE_ENDS
  49. '
  50. XPOS=0 : YPOS=0 : SPOS=0
  51. '
  52. Def Scroll 1,0,0 To 640,240,0,8
  53. Def Scroll 2,0,0 To 640,248,0,-8
  54. '
  55. '************************************************  MAIN PROGRAM LOOP 
  56. Do 
  57.    XPOS=X Curs
  58.    YPOS=Y Curs
  59.    Locate XPOS,YPOS
  60.    K$=""
  61.    Clear Key 
  62.    While K$=""
  63.       Inverse On 
  64.       CHARACTER_PRINT
  65.       GIVE_LINE_STATUS
  66.       MP=Mouse Key
  67.       If MP=1 Then POSITION_WITH_MOUSE
  68.       If Key Shift=8 Then ALT_LINES
  69.       K$=Inkey$ : If K$<>"" Then K=Asc(K$)
  70.       If K=8 Then DELETE_CHARACTER
  71.       If K=13 Then NEWLINE
  72.       If K=30 Then POSITION_WITH_UP_ARROW
  73.       If K=31 Then POSITION_WITH_DN_ARROW
  74.       If K=28 Then POSITION_WITH_RT_ARROW
  75.       If K=29 Then POSITION_WITH_LT_ARROW
  76.       If(K>31 and K<192) Then CHR_INP[K$]
  77.       K=0 : K$=""
  78.       Menu On : On Menu On 
  79.    Wend 
  80. Loop 
  81. '  
  82. Edit 
  83. '************************************************  WARNING PROCEDURES  
  84. Procedure QUERY[A$,B$,C$,D$]
  85.    Inverse Off 
  86.    Screen 1 : Wind Save : Wind Open 3,40,50,70,8,1 : Wind Save 
  87.    Curs Off : Border 2,5,7 : Pen 6 : Paper 5 : Clw 
  88.    C$=Zone$(Border$(C$,2),1) : D$=Zone$(Border$(D$,2),2)
  89.    Print : Print : Centre A$ : Print : Print : Centre B$
  90.    ANSW=0
  91.    Repeat 
  92.       ANSW=Mouse Zone
  93.       If ANSW=1
  94.          Inverse On : Locate 5,2 : Print C$
  95.       Else 
  96.          Inverse Off : Locate 5,2 : Print C$
  97.       End If 
  98.       If ANSW=2
  99.          Inverse On : Locate 73-Len(D$),2 : Print D$
  100.       Else 
  101.          Inverse Off : Locate 73-Len(D$),2 : Print D$
  102.       End If 
  103.    Until Mouse Key
  104.    Wind Close 
  105. End Proc[ANSW]
  106. Procedure CONFIRM_QUERY[A$,B$,C$,D$]
  107.    Inverse Off 
  108.    Screen 1 : Wind Save : Wind Open 4,150,10,44,10,1 : Wind Save 
  109.    Curs Off : Border 2,5,7 : Pen 6 : Paper 5 : Clw 
  110.    A$=Zone$(Border$(A$,2),3) : B$=Zone$(Border$(B$,2),4)
  111.    C$=Zone$(Border$(C$,2),5)
  112.    Print : Centre D$ : ANSW=0
  113.    Repeat 
  114.       ANSW=Mouse Zone
  115.       If ANSW=3
  116.          Inverse On : Locate 4,5 : Print A$
  117.       Else 
  118.          Inverse Off : Locate 4,5 : Print A$
  119.       End If 
  120.       If ANSW=4
  121.          Inverse On : Centre B$
  122.       Else 
  123.          Inverse Off : Centre B$
  124.       End If 
  125.       If ANSW=5
  126.          Inverse On : Locate 51-Len(C$),5 : Print C$
  127.       Else 
  128.          Inverse Off : Locate 51-Len(C$),5 : Print C$
  129.       End If 
  130.    Until Mouse Key
  131.    Wind Close 
  132. End Proc[ANSW-2]
  133. Procedure ALERT[A$,B$,C$,NOISY]
  134.    Screen 1 : Inverse Off : D$="<<< Press Mouse Key to Continue >>>"
  135.    Wind Save : Wind Open 2,0,190,78,8,1 : Wind Save 
  136.    Curs Off : Border 2,6-NOISY,0 : Pen 0 : Paper 6-NOISY : Clw 
  137.    Print : Centre A$ : Print : Centre B$ : Print 
  138.    Centre C$ : Print : Print : Pen 3 : Centre D$
  139.    If NOISY : For Z=0 To 3 : Shoot : Wait 5 : Shoot : Next Z : End If 
  140.    While Mouse Key : Wend 
  141.    Repeat : Until Mouse Key
  142.    Wind Close 
  143. End Proc
  144. Procedure INFO_ON[A$,B$]
  145.    Inverse Off 
  146.    Screen 1 : Wind Save : Wind Open 5,120,30,50,8,1 : Wind Save 
  147.    Curs Off : Border 2,2,1 : Pen 6 : Paper 2 : Clw 
  148.    Print : Centre A$ : Print : Print : Centre B$
  149. End Proc
  150. Procedure INFO_OFF
  151.    Window 5 : Wind Close 
  152. End Proc
  153. '************************************************  OPENING PROCEDURES  
  154. Procedure INIT_LINE_ENDS
  155.    TLC$="" : TRC$="" : BLC$="" : BRC$=""
  156.    For Z=1 To 15 : Read X : TLC$=TLC$+Chr$(X) : Next Z
  157.    For Z=1 To 15 : Read X : TRC$=TRC$+Chr$(X) : Next Z
  158.    For Z=1 To 15 : Read X : BLC$=BLC$+Chr$(X) : Next Z
  159.    For Z=1 To 15 : Read X : BRC$=BRC$+Chr$(X) : Next Z
  160.    Data 144,136,144,136,144,136,144,142,146,142,146,142,146,142,146
  161.    Data 145,142,146,138,145,142,146,138,145,142,146,138,145,142,146
  162.    Data 140,140,140,144,144,144,144,143,143,143,143,146,146,146,146
  163.    Data 141,143,143,145,145,146,146,141,141,143,143,145,145,146,146
  164. End Proc
  165. Procedure INIT_MENU
  166.    Menu$(1)=" Options     "
  167.    Menu$(1,1)=" New  Form - F1  ","(IN 1,7 : IN 2,5) ARE YOU SURE !! "
  168.    Menu$(1,2)=" About F.R.U     ","(IN 1,2 : IN 2,6) ITS COPYRIGHTED "
  169.    Menu$(1,3)=" Q U I T   - Esc ","(IN 1,2 : IN 2,7)  Press Esc  Key "
  170.    Menu$(2)=" Files    "
  171.    Menu$(2,1)=" Load Form - F2  "
  172.    Menu$(2,2)=" Save Form - F3  "
  173.    Menu$(2,3)=" Save As   - F4  "
  174.    Menu$(2,4)=" Make Sub-Direc. ","(IN 1,2 : IN 2,6)  or New Folder  "
  175.    Menu$(2,5)=" Disc Directory  "
  176.    Menu$(2,6)=" Kill Files      ","(IN 1,3 : IN 2,7) NOT RECOVERABLE "
  177.    Menu$(2,7)=" Rename a File   "
  178.    Menu$(3)=" Edit     "
  179.    Menu$(3,1)=" Draw Box   - F5 "
  180.    Menu$(3,2)=" Draw Line  - F6 "
  181.    Menu$(3,3)=" Clear Area - F7 "
  182.    Menu$(3,4)=" Justify    - F8 "
  183.    Menu$(3,5)=" Adj Length - F9 "
  184.    Menu$(4)=" Printer    "
  185.    Menu$(4,1)=" Print Form - F10  "
  186.    Menu$(4,2)=" Change Parameters ","(IN 1,2 : IN 2,6)and Printer Setting"
  187.    Menu Key(1,1) To 80
  188.    Menu Key(1,3) To 69
  189.    Menu Key(2,1) To 81
  190.    Menu Key(2,2) To 82
  191.    Menu Key(2,3) To 83
  192.    Menu Key(3,1) To 84
  193.    Menu Key(3,2) To 85
  194.    Menu Key(3,3) To 86
  195.    Menu Key(3,4) To 87
  196.    Menu Key(3,5) To 88
  197.    Menu Key(4,1) To 89
  198. End Proc
  199. Procedure INIT_PARAMS
  200.    Dim PRT$(10)
  201.    If Not Exist(":Param.fle") Then Pop Proc
  202.    Open In 1,":Param.fle"
  203.    VAR=0
  204.    While Not Eof(1)
  205.       Input #1,PRT$(VAR)
  206.       Inc VAR
  207.    Wend 
  208.    Close 1
  209.    Dir$=PRT$(0)+PRT$(1)
  210. End Proc
  211. '************************************************  POSITION PROCEDURES   
  212. Procedure REDO_PARAMETERS
  213.    Screen 1 : Wind Save : Wind Open 1,120,10,50,16,1 : Wind Save 
  214.    Curs Off : Border 2,5,7 : Pen 6 : Paper 5 : Clw 
  215.    A$="FORMS REALLY UNLIMITED - "+VERSION$ : B$=String$("=",Len(A$))
  216.    Print : Centre A$ : Print : Centre B$ : Print 
  217.    C$="File Name :- "+FILENAME$ : D$=String$("-",Len(C$))
  218.    Print : Centre C$ : Print : Centre D$
  219.    Locate 3,7 : Print "Form Length Currently:";UPPER_LIMIT
  220.    WRONG:
  221.    Put Key "50"
  222.    Locate 9,10 : Input "New Form Length: ";NEW_LIMIT$
  223.    If NEW_LIMIT$="" : Goto OK_LIMIT : End If 
  224.    NEW_LIMIT=Val(NEW_LIMIT$)
  225.    If(NEW_LIMIT<31 or NEW_LIMIT>450)
  226.       ALERT["Minimum Limit for FORM LENGTH =  31 Lines","","Maximum Limit for FORM LENGTH = 450 Lines",-1]
  227.       Goto WRONG
  228.    End If 
  229.    If NEW_LIMIT>UPPER_LIMIT
  230.       LINE$=LINE$+Space$((NEW_LIMIT-UPPER_LIMIT+1)*SCR_WIDTH)
  231.    End If 
  232.    UPPER_LIMIT=NEW_LIMIT
  233.    OK_LIMIT:
  234.    Wind Close : Locate 0,0 : On Menu On 
  235. End Proc
  236. Procedure GIVE_LINE_STATUS
  237.    Inverse On 
  238.    Locate 0,31
  239.    Print "  Line:"+Right$(" "+Str$(YPOS+SPOS+1),3);
  240.    Print "  Col:"+Right$(Str$(XPOS+1),2);
  241.    Print "    Caps Lock: ";
  242.    If(Key Shift and 4)=4 : Print "ON "; : Else Print "OFF"; : End If 
  243.    Print "    Edit: ";FILENAME$;Space$(34);
  244.    Inverse Off 
  245. End Proc
  246. Procedure DELETE_CHARACTER
  247.    Locate XPOS,YPOS
  248.    A=Asc(Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS,1))
  249.    If(A>135 and A<147) : Bell : Pop Proc : End If 
  250.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS,1)=" "
  251.    Inverse Off 
  252.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS+1,1);
  253.    Dec XPOS
  254.    If XPOS<0 : XPOS=0 : Bell : End If 
  255.    Locate XPOS,YPOS
  256. End Proc
  257. Procedure YPOS_LTEST
  258.    If YPOS>SCR_LIMIT
  259.       YPOS=SCR_LIMIT
  260.       Inc SPOS
  261.       If SPOS>UPPER_LIMIT-SCR_LIMIT-1
  262.          SPOS=UPPER_LIMIT-SCR_LIMIT-1
  263.          Bell 
  264.       Else 
  265.          Scroll 2
  266.          BASE_LINE_PRINT
  267.       End If 
  268.    End If 
  269.    Locate XPOS,YPOS
  270. End Proc
  271. Procedure NEWLINE
  272.    Locate XPOS,YPOS
  273.    If YPOS+SPOS+1=UPPER_LIMIT : Bell : Pop Proc : End If 
  274.    A=Asc(Mid$(LINE$,(YPOS+SPOS+1)*SCR_WIDTH+XPOS+1,1))
  275.    B=Asc(Mid$(LINE$,(YPOS+SPOS+1)*SCR_WIDTH+XPOS,1))
  276.    If(A=139 and B<>137) or B=141 : Goto CONT : End If 
  277.    If(A>135 and A<147) : Bell : Pop Proc : End If 
  278.    CONT:
  279.    Inverse Off 
  280.    CHARACTER_PRINT
  281.    Inc YPOS : YPOS_LTEST
  282.    For Z=0 To 80
  283.       Exit If Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS,1)=Chr$(139),1
  284.       Dec XPOS : If XPOS<0 : XPOS=0 : Bell : Z=80 : End If 
  285.    Next Z
  286.    Locate XPOS,YPOS
  287. End Proc
  288. Procedure ALT_LINES
  289.    K$=Inkey$
  290.    If Lower$(K$)="i" Then Goto ALT_INSERT
  291.    If Lower$(K$)="u" Then Goto ALT_UNDOIT
  292.    If Lower$(K$)="y" Then Goto ALT_DELETE
  293.    Clear Key : Pop Proc
  294.    ALT_INSERT:
  295.    If UPPER_LIMIT=450 : Bell : Pop Proc : End If 
  296.    Inc UPPER_LIMIT
  297.    Mid$(LINE$,UPPER_LIMIT*SCR_WIDTH+1,160)=Space$(160)
  298.    For Z=UPPER_LIMIT To YPOS+SPOS+1 Step -1
  299.       Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)=Mid$(LINE$,(Z-1)*SCR_WIDTH+1,SCR_WIDTH)
  300.    Next Z
  301.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH)=Space$(80)
  302.    Memorize X : Memorize Y : Locate 0,YPOS
  303.    For Z=YPOS To 30
  304.       Print Mid$(LINE$,(Z+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  305.    Next Z
  306.    Remember X : Remember Y : CHARACTER_PRINT
  307.    Pop Proc
  308.    ALT_UNDOIT:
  309.    If Len(ALT$)=0 : Pop Proc : End If 
  310.    For Z=UPPER_LIMIT To YPOS+SPOS+1 Step -1
  311.       Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)=Mid$(LINE$,(Z-1)*SCR_WIDTH+1,SCR_WIDTH)
  312.    Next Z
  313.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH)=ALT$ : ALT$=""
  314.    Memorize X : Memorize Y : Locate 0,YPOS
  315.    For Z=YPOS To 30
  316.       Print Mid$(LINE$,(Z+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  317.    Next Z
  318.    Remember X : Remember Y : CHARACTER_PRINT
  319.    Pop Proc
  320.    ALT_DELETE:
  321.    ALT$=Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH)
  322.    For Z=YPOS+SPOS To UPPER_LIMIT-1
  323.       Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)=Mid$(LINE$,(Z+1)*SCR_WIDTH+1,SCR_WIDTH)
  324.    Next Z
  325.    If UPPER_LIMIT=31
  326.       Mid$(LINE$,UPPER_LIMIT*SCR_WIDTH+1,SCR_WIDTH)=Space$(80)
  327.    Else 
  328.       Dec UPPER_LIMIT
  329.    End If 
  330.    Memorize X : Memorize Y : Locate 0,YPOS
  331.    For Z=YPOS To 31
  332.       Print Mid$(LINE$,(Z+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  333.    Next Z
  334.    Remember X : Remember Y : CHARACTER_PRINT
  335. End Proc
  336. Procedure POSITION_WITH_MOUSE
  337.    Inverse Off 
  338.    Locate XPOS,YPOS
  339.    CHARACTER_PRINT
  340.    XPOS=Int((X Mouse-128)/4)
  341.    YPOS=Int((Y Mouse-38)/8)
  342.    If YPOS=0
  343.       Dec SPOS
  344.       If SPOS<0
  345.          SPOS=0 : Bell 
  346.       Else 
  347.          Scroll 1 : UPPER_LINE_PRINT
  348.       End If 
  349.    End If 
  350.    YPOS_LTEST : CHECK_CHAR
  351. End Proc
  352. Procedure CHECK_CHAR
  353.    If Key Shift<>4 Then Pop Proc
  354.    X$=Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1+XPOS,1)
  355.    If(Asc(X$)<136 or Asc(X$)>146) : Pop Proc : End If 
  356.    Z=(YPOS+SPOS)*SCR_WIDTH+XPOS+1
  357.    If YPOS+SPOS=0 Then A=0 : Else A=Asc(Mid$(LINE$,Z-SCR_WIDTH,1))
  358.    If XPOS=79 Then B=0 : Else B=Asc(Mid$(LINE$,Z+1,1))
  359.    If YPOS+SPOS=UPPER_LIMIT Then C=0 : Else C=Asc(Mid$(LINE$,Z+SCR_WIDTH,1))
  360.    If XPOS=0 Then D=0 : Else D=Asc(Mid$(LINE$,Z-1,1))
  361.    CHECK$=Str$(A+B+C+D)
  362.    If Instr(" 0 1 2 4 8",CHECK$)>0 Then Pop Proc
  363.    CHAR$="   "+Chr$(140)+" "+Chr$(139)+Chr$(136)+Chr$(144)+" "+Chr$(141)
  364.    CHAR$=CHAR$+Chr$(137)+Chr$(143)+Chr$(138)+Chr$(145)+Chr$(142)+Chr$(146)
  365.    A=1*(A=137)-1*(A>135) : B=2*(B=139)-2*(B>135)
  366.    C=4*(C=137)-4*(C>135) : D=8*(D=139)-8*(D>135)
  367.    Mid$(LINE$,Z,1)=Mid$(CHAR$,A+B+C+D+1,1)
  368. End Proc
  369. Procedure POSITION_WITH_UP_ARROW
  370.    Inverse Off 
  371.    Locate XPOS,YPOS
  372.    CHARACTER_PRINT
  373.    Dec YPOS
  374.    If YPOS<0
  375.       YPOS=0
  376.       Dec SPOS
  377.       If SPOS<0
  378.          SPOS=0 : Bell 
  379.       Else 
  380.          Scroll 1 : UPPER_LINE_PRINT : Locate XPOS,YPOS
  381.       End If 
  382.    End If 
  383. End Proc
  384. Procedure POSITION_WITH_DN_ARROW
  385.    Inverse Off 
  386.    Locate XPOS,YPOS
  387.    CHARACTER_PRINT
  388.    Inc YPOS
  389.    YPOS_LTEST
  390. End Proc
  391. Procedure POSITION_WITH_RT_ARROW
  392.    Inverse Off 
  393.    Locate XPOS,YPOS
  394.    CHARACTER_PRINT
  395.    Inc XPOS
  396.    If XPOS>79 : XPOS=79 : Bell : End If 
  397. End Proc
  398. Procedure POSITION_WITH_LT_ARROW
  399.    Inverse Off 
  400.    Locate XPOS,YPOS
  401.    CHARACTER_PRINT
  402.    Dec XPOS
  403.    If XPOS<0 : XPOS=0 : Bell : End If 
  404. End Proc
  405. Procedure CHARACTER_PRINT
  406.    Locate XPOS,YPOS
  407.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS+1,1);
  408. End Proc
  409. Procedure CHR_INP[Q$]
  410.    Locate XPOS,YPOS
  411.    A=Asc(Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS+1,1))
  412.    If(A>135 and A<147) : Bell : Pop Proc : End If 
  413.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+XPOS+1,1)=Q$
  414.    Inverse Off 
  415.    Print Q$;
  416.    Inc XPOS
  417.    If XPOS>79 : XPOS=79 : Bell : End If 
  418.    Locate XPOS,YPOS
  419. End Proc
  420. Procedure UPPER_LINE_PRINT
  421.    Inverse Off 
  422.    Locate 0,0
  423.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  424. End Proc
  425. Procedure BASE_LINE_PRINT
  426.    Inverse Off 
  427.    Locate 0,30
  428.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  429. End Proc
  430. '************************************************  DRAWING PROCEDURES  
  431. Procedure CLR_BOX
  432.    Inverse Off 
  433.    CX1=X Text(GX1) : CX2=X Text(GX2)
  434.    CY1=Y Text(GY1) : CY2=Y Text(GY2)
  435.    If(CX1=CX2) or(CY1=CY2)
  436.       ALERT[" ","CAN'T CLEAR SINGLE POINTS !!"," ",0]
  437.       Pop Proc
  438.    End If 
  439.    Change Mouse 1
  440.    QUERY["ARE YOU SURE",""," YES "," NO "]
  441.    If Param=2 : Pop Proc : End If 
  442.    For Z=CY1 To CY2
  443.       Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+CX1+1,CX2-CX1+1)=Space$(CX2-CX1+1)
  444.       Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+CX1+1,CX2-CX1+1)=Space$(CX2-CX1+1)
  445.    Next Z
  446.    Locate 0,0
  447.    For Z=0 To 30
  448.       Print Mid$(LINE$,(Z+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  449.    Next Z
  450. End Proc
  451. Procedure SET_BOX
  452.    Gr Writing 2
  453.    CX1=0 : CX2=0
  454.    GX1=0 : GY1=0
  455.    Repeat 
  456.       If Mouse Key=1
  457.          GX1=X Screen(X Mouse) : GY1=Y Screen(Y Mouse)
  458.          GX2=GX1 : GY2=GY1
  459.          While Mouse Key=1
  460.             Box GX1,GY1 To GX2,GY2
  461.             GX2=X Screen(X Mouse) : GY2=Y Screen(Y Mouse)
  462.             Box GX1,GY1 To GX2,GY2
  463.          Wend 
  464.          Box GX1,GY1 To GX2,GY2 : GRABBED=True
  465.          If GX1>GX2 : Swap GX1,GX2 : End If 
  466.          If GY1>GY2 : Swap GY1,GY2 : End If 
  467.       End If 
  468.    Until GRABBED
  469.    Gr Writing 1
  470. End Proc
  471. Procedure SET_LINE
  472.    Gr Writing 2
  473.    CX1=0 : CX2=0
  474.    GX1=0 : GY2=0
  475.    Repeat 
  476.       If Mouse Key=1
  477.          GX1=X Screen(X Mouse) : GY1=Y Screen(Y Mouse)
  478.          GX2=GX1 : GY2=GY1
  479.          While Mouse Key=1
  480.             Draw GX1,GY1 To GX2,GY2
  481.             GX2=X Screen(X Mouse) : GY2=Y Screen(Y Mouse)
  482.             Draw GX1,GY1 To GX2,GY2
  483.          Wend 
  484.          Draw GX1,GY1 To GX2,GY2 : GRABBED=True
  485.          If GX1>GX2 : Swap GX1,GX2 : End If 
  486.          If GY1>GY2 : Swap GY1,GY2 : End If 
  487.       End If 
  488.    Until GRABBED
  489.    Gr Writing 1
  490. End Proc
  491. Procedure SHAPE_BOX
  492.    CX1=X Text(GX1) : If CX1<0 : CX1=0 : End If 
  493.    CX2=X Text(GX2) : If CX2>79 : CX2=79 : End If 
  494.    CY1=Y Text(GY1) : If CY1<0 : CY=0 : End If 
  495.    CY2=Y Text(GY2) : If CY2>30 : CY2=30 : End If 
  496.    If(CX1=CX2) or(CY1=CY2)
  497.       ALERT[" ","CAN'T DRAW SINGLE POINTS !!"," ",0]
  498.       Pop Proc
  499.    End If 
  500.    If(CX2-CX1)>1
  501.       For Z=CX1+1 To CX2-1
  502.          Mid$(LINE$,(SPOS+CY1)*SCR_WIDTH+Z+1,1)=Chr$(137)
  503.          Mid$(LINE$,(SPOS+CY2)*SCR_WIDTH+Z+1,1)=Chr$(137)
  504.       Next Z
  505.    End If 
  506.    If(CY2-CY1)>1
  507.       For Z=CY1+1 To CY2-1
  508.          Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+CX1+1,1)=Chr$(139)
  509.          Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+CX2+1,1)=Chr$(139)
  510.       Next Z
  511.    End If 
  512.    CHECK_TL : Mid$(LINE$,(SPOS+CY1)*SCR_WIDTH+CX1+1,1)=Mid$(TLC$,Param,1)
  513.    CHECK_TR : Mid$(LINE$,(SPOS+CY1)*SCR_WIDTH+CX2+1,1)=Mid$(TRC$,Param,1)
  514.    CHECK_BL : Mid$(LINE$,(SPOS+CY2)*SCR_WIDTH+CX1+1,1)=Mid$(BLC$,Param,1)
  515.    CHECK_BR : Mid$(LINE$,(SPOS+CY2)*SCR_WIDTH+CX2+1,1)=Mid$(BRC$,Param,1)
  516.    For Z=0 To 30
  517.       Locate 0,Z
  518.       Print Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+1,SCR_WIDTH);
  519.    Next Z
  520. End Proc
  521. Procedure CHECK_TL
  522.    A=0 : B=0 : C=0 : D=0
  523.    If(CY1=0 and SPOS=0) : A=0 : Else A=Asc(Mid$(LINE$,(CY1-1+SPOS)*SCR_WIDTH+CX1+1,1)) : End If 
  524.    B=Asc(Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX1+2,1))
  525.    C=Asc(Mid$(LINE$,(CY1+1+SPOS)*SCR_WIDTH+CX1+1,1))
  526.    If CX1=0 : D=0 : Else D=Asc(Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX1,1)) : End If 
  527.    If(CX1=0 and CY1=0 and SPOS=0) : A=0 : D=0 : End If 
  528.    A=-1*(A=139) : B=-2*(B=137) : C=-4*(C=139) : D=-8*(D=137)
  529. End Proc[A+B+C+D]
  530. Procedure CHECK_TR
  531.    A=0 : B=0 : C=0 : D=0
  532.    If(CY1=0 and SPOS=0) : A=0 : Else A=Asc(Mid$(LINE$,(CY1-1+SPOS)*SCR_WIDTH+CX2+1,1)) : End If 
  533.    If CX2=79 : B=0 : Else B=Asc(Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX2+2,1)) : End If 
  534.    C=Asc(Mid$(LINE$,(CY1+1+SPOS)*SCR_WIDTH+CX2+1,1))
  535.    D=Asc(Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX2,1))
  536.    A=-1*(A=139) : B=-2*(B=137) : C=-4*(C=139) : D=-8*(D=137)
  537. End Proc[A+B+C+D]
  538. Procedure CHECK_BL
  539.    A=0 : B=0 : C=0 : D=0
  540.    If CY2+SPOS=UPPER_LIMIT : C=0 : Else C=Asc(Mid$(LINE$,(CY2+1+SPOS)*SCR_WIDTH+CX1+1,1)) : End If 
  541.    If CX1=0 : D=0 : Else D=Asc(Mid$(LINE$,(CY2+SPOS)*SCR_WIDTH+CX1,1)) : End If 
  542.    If(CX1=0 and CY2+SPOS=UPPER_LIMIT) : C=0 : D=0 : End If 
  543.    A=Asc(Mid$(LINE$,(CY2-1+SPOS)*SCR_WIDTH+CX1+1,1))
  544.    B=Asc(Mid$(LINE$,(CY2+SPOS)*SCR_WIDTH+2+CX1,1))
  545.    A=-1*(A=139) : B=-2*(B=137) : C=-4*(C=139) : D=-8*(D=137)
  546. End Proc[A+B+C+D]
  547. Procedure CHECK_BR
  548.    A=0 : B=0 : C=0 : D=0
  549.    If CX2=79 : B=0 : Else B=Asc(Mid$(LINE$,(CY2+SPOS)*SCR_WIDTH+CX2+2,1)) : End If 
  550.    If CY2+SPOS=UPPER_LIMIT : C=0 : Else C=Asc(Mid$(LINE$,(CY2+1+SPOS)*SCR_WIDTH+CX2+1,1)) : End If 
  551.    If(CX2=79 and CY2+SPOS=UPPER_LIMIT) : B=0 : C=0 : End If 
  552.    A=Asc(Mid$(LINE$,(CY2-1+SPOS)*SCR_WIDTH+CX2+1,1))
  553.    D=Asc(Mid$(LINE$,(CY2+SPOS)*SCR_WIDTH+CX2,1))
  554.    A=-1*(A=139) : B=-2*(B=137) : C=-4*(C=139) : D=-8*(D=137)
  555. End Proc[A+B+C+D]
  556. Procedure SHAPE_LINE
  557.    CX1=X Text(GX1) : If CX1<0 : CX1=0 : End If 
  558.    CX2=X Text(GX2) : If CX2>79 : CX2=79 : End If 
  559.    CY1=Y Text(GY1) : If CY1<0 : CY1=0 : End If 
  560.    CY2=Y Text(GY2) : If CY2>30 : CY2=30 : End If 
  561.    If(CX2-CX1)>4 : Goto HORIZ_LINE : End If 
  562.    If(CY2-CY1)>1 : Goto VERT_LINE : End If 
  563.    MISTAKE:
  564.    ALERT["","CAN'T DRAW ANGLED LINES","",0]
  565.    Pop Proc
  566.    HORIZ_LINE:
  567.    If(CY2-CY1)>1 : Goto MISTAKE : End If 
  568.    Mid$(LINE$,(SPOS+CY1)*SCR_WIDTH+CX1+1,1)=Chr$(137)
  569.    Mid$(LINE$,(SPOS+CY1)*SCR_WIDTH+CX2+1,1)=Chr$(137)
  570.    For Z=CX1+1 To CX2-1
  571.       Mid$(LINE$,(SPOS+CY1)*SCR_WIDTH+Z+1,1)=Chr$(137)
  572.    Next Z
  573.    Goto PRT_A_LINE
  574.    VERT_LINE:
  575.    If(CX2-CX1)>4 Then Goto MISTAKE
  576.    For Z=CY1 To CY2
  577.       Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+CX1+1,1)=Chr$(139)
  578.    Next Z
  579.    PRT_A_LINE:
  580.    For Z=0 To 30
  581.       Locate 0,Z
  582.       Print Mid$(LINE$,(SPOS+Z)*SCR_WIDTH+1,SCR_WIDTH);
  583.    Next Z
  584. End Proc
  585. Procedure JUSTIFY_LINE[A$,ANSW]
  586.    ML=0 : FIND_MOVES_LEFT : ML=Param
  587.    MR=0 : FIND_MOVES_RIGHT : MR=Param
  588.    If ANSW=4 Then Goto OK_RIGHT
  589.    If ANSW=3 Then Goto OK_CENTRE
  590.    If ANSW<>2 Then Pop Proc
  591.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+CX1+1-ML,Len(A$)+ML)=A$+Space$(ML)
  592.    Locate 0,YPOS : Inverse Off 
  593.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  594.    Pop Proc
  595.    OK_RIGHT:
  596.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+CX1+1,Len(A$)+MR)=Space$(MR)+A$
  597.    Locate 0,YPOS : Inverse Off 
  598.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  599.    Pop Proc
  600.    OK_CENTRE:
  601.    MC=(Int(ML+MR)/2)
  602.    Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+CX1+1-ML,ML+Len(A$)+MR)=Space$(MC)+A$+Space$(MC+2)
  603.    Locate 0,YPOS : Inverse Off 
  604.    Print Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+1,SCR_WIDTH);
  605. End Proc
  606. Procedure FIND_MOVES_LEFT
  607.    For Z=CX1 To 1 Step -1
  608.       X=Asc(Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+Z,1))
  609.       Exit If(X>135 and X<147),1
  610.    Next Z
  611. End Proc[CX1-Z]
  612. Procedure FIND_MOVES_RIGHT
  613.    For Z=CX2 To 80
  614.       X=Asc(Mid$(LINE$,(YPOS+SPOS)*SCR_WIDTH+Z+1,1))
  615.       If(X>135 and X<147) : Inc Z : Exit : End If 
  616.    Next Z
  617. End Proc[Z-CX2-2]
  618. '************************************************  Main Menu Options   
  619. Procedure CH_OPT
  620.    ITEM=Choice(2)
  621.    On ITEM Proc OPT_NEW,OPT_ABOUT,OPT_QUIT
  622.    On Menu On 
  623. End Proc
  624. Procedure CH_FLE
  625.    ITEM=Choice(2)
  626.    On ITEM Proc FLE_LOAD,FLE_SAVE,FLE_SAVEAS,FLE_MKDIR,FLE_DIR,FLE_KILL,FLE_RENAME
  627.    On Menu On 
  628. End Proc
  629. Procedure CH_INP
  630.    CHANGE_FLAG=True : ITEM=Choice(2)
  631.    On ITEM Proc INP_BOX,INP_LINE,INP_CLEAR,INP_JUSTIFY,INP_LENGTH
  632.    On Menu On 
  633. End Proc
  634. Procedure CH_PRT
  635.    ITEM=Choice(2)
  636.    On ITEM Proc PRT_PRINT,PRT_CH_PRINTER
  637.    On Menu On 
  638. End Proc
  639. '************************************************  Menu 1 Options  
  640. Procedure OPT_NEW
  641.    Inverse Off 
  642.    QUERY["THIS WILL CLEAR ALL MEMORY","----- CONTINUE -----"," OK "," NO "]
  643.    If Param<>1 Then Pop Proc
  644.    Cls : Locate XPOS,YPOS : Inverse Off : Print " ";
  645.    FILENAME$="noname"
  646.    REDO_PARAMETERS
  647.    LINE$=Space$(UPPER_LIMIT*SCR_WIDTH)
  648.    XPOS=0 : YPOS=0 : Locate XPOS,YPOS
  649. End Proc
  650. Procedure OPT_ABOUT
  651.    A$="Howard Meek"
  652.    B$="247 Lichfield Road, Rushall,"
  653.    C$="Walsall.  WS4 1EA"
  654.    ALERT[A$,B$,C$,0]
  655. End Proc
  656. Procedure OPT_QUIT
  657.    Inverse Off 
  658.    If Left$(FILENAME$,6)="noname" Then CHANGE_FLAG=0
  659.    If CHANGE_FLAG Then QUERY["Save "+FILENAME$+" before Quitting",""," yes "," no "]
  660.    If(Param=1 and CHANGE_FLAG) Then FLE_SAVE
  661.    QUERY["DO YOU REALLY WANT TO END IT ALL ?"," "," YYUP "," NOPE "]
  662.    If Param<>1 Then Pop Proc
  663.    Edit 
  664. End Proc
  665. '************************************************  Menu 2 Options
  666. Procedure FLE_LOAD
  667.    LFILE:
  668.    F$=Fsel$("*.fru","","FORMS REALLY UNLIMITED","Load a FORM")
  669.    If F$="" Then Pop Proc
  670.    If Mid$(F$,Instr(F$,"/")+1,1)="*"
  671.       ALERT["You Cannot LOAD a Pattern","","Please Enter a Filename !!",-1]
  672.       Goto LFILE
  673.    End If 
  674.    If Lower$(Right$(F$,4))<>".fru" : F$=F$+".fru" : End If 
  675.    If Not Exist(F$)
  676.       ALERT[F$+" does NOT exist in the Current Directory","","Please try again",-1]
  677.       Goto LFILE
  678.    End If 
  679.    FILENAME$=F$ : GIVE_LINE_STATUS
  680.    INFO_ON["Loading "+FILENAME$,"Please Wait"]
  681.    On Menu Off : Change Mouse 3
  682.    Open In 1,FILENAME$
  683.    Input #1,UPPER_LIMIT
  684.    LINE$=Space$(UPPER_LIMIT*SCR_WIDTH) : A$=""
  685.    For Z=0 To UPPER_LIMIT-1
  686.       Exit If Eof(1),1
  687.       A$=Input$(1,SCR_WIDTH) : X$=Input$(1,2)
  688.       Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)=A$
  689.    Next Z
  690.    Close 1 : INFO_OFF : Inverse Off : Cls 
  691.    For Z=0 To 30
  692.       Print Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH);
  693.    Next Z
  694.    Change Mouse 1 : Menu On : On Menu On 
  695.    CHANGE_FLAG=False : Locate 0,0
  696. End Proc
  697. Procedure FLE_SAVE
  698.    If Right$(FILENAME$,6)="noname"
  699.       FLE_SAVEAS
  700.       Pop Proc
  701.    End If 
  702.    INFO_ON["Saving "+FILENAME$,"Please Wait"]
  703.    On Menu Off : Change Mouse 3
  704.    Open Out 1,FILENAME$
  705.    Print #1,UPPER_LIMIT
  706.    For Z=0 To UPPER_LIMIT-1
  707.       Print #1,Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)
  708.    Next Z
  709.    Close 1
  710.    INFO_OFF : Menu On : On Menu On 
  711.    Change Mouse 1 : CHANGE_FLAG=0
  712. End Proc
  713. Procedure FLE_SAVEAS
  714.    If CHANGE_FLAG=False Then Pop Proc
  715.    SFILE:
  716.    F$=Fsel$("*.fru","","FORMS REALLY UNLIMITED","Save a FORM")
  717.    If F$="" Then Pop Proc
  718.    If Mid$(F$,Instr(F$,"/")+1,1)="*"
  719.       ALERT["You Cannot SAVE a Pattern","","Please Enter a Filename !!",-1]
  720.       Goto SFILE
  721.    End If 
  722.    If Lower$(Right$(F$,4))<>".fru" : F$=F$+".fru" : End If 
  723.    FILENAME$=F$
  724.    INFO_ON["Saving "+FILENAME$,"Please Wait"]
  725.    On Menu Off : Change Mouse 3
  726.    Open Out 1,FILENAME$
  727.    Print #1,UPPER_LIMIT
  728.    For Z=0 To UPPER_LIMIT-1
  729.       Print #1,Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)
  730.    Next Z
  731.    Close 1
  732.    INFO_OFF : Menu On : On Menu On 
  733.    Change Mouse 1 : CHANGE_FLAG=0
  734. End Proc
  735. Procedure FLE_MKDIR
  736.    X=Instr(Dir$,":") : D$=Upper$(Left$(Dir$,4))
  737.    Inverse Off : Screen 1 : Flash 4,"(0f0,20)(044,20)"
  738.    Wind Save : Wind Open 6,160,100,40,14,1 : Wind Save 
  739.    Border 2,5,7 : Pen 6 : Paper 5 : Clw 
  740.    NWDIR:
  741.    Clw : Curs On : Locate 2,1 : Print "Current Drive :- ";D$
  742.    Locate 2,3 : Print "Enter FULL NAME from Root"
  743.    Locate 6,5 : Print "Input Space to exit"
  744.    Locate 2,8 : Put Key D$ : Input TEMP$;
  745.    If Right$(TEMP$,1)=" " Then Wind Close : Pop Proc
  746.    If TEMP$="" Then Goto NWDIR
  747.    X=Instr(TEMP$,":") : If X>5 Then Goto NWDIR
  748.    If X>0
  749.       D$=Upper$(Left$(TEMP$,X))
  750.       TEMP$=Right$(TEMP$,Len(TEMP$)-X)
  751.    End If 
  752.    CHECK$=D$+TEMP$
  753.    If Exist(CHECK$)
  754.       ALERT[CHECK$,"","Already exists !!!",-1]
  755.       Goto NWDIR
  756.    End If 
  757.    CONFIRM_QUERY[" yes "," quit "," no  ",CHECK$]
  758.    If Param=3 Then Goto NWDIR
  759.    If Param<>1 Then Wind Close : Pop Proc
  760.    Mkdir CHECK$ : Dir$=CHECK$
  761.    Wind Close : Curs Off : Flash Off 
  762.    FLE_DIR
  763. End Proc
  764. Procedure FLE_DIR
  765.    CONFIRM_QUERY[" Yes "," Quit "," No ",Dir$+" :- Current Directory"]
  766.    If Param=2 Then Pop Proc
  767.    If Param=1 Then Goto CONT_DIR
  768.    If Param<>3 Then Pop Proc
  769.    Screen 1 : Wind Save : Wind Open 7,130,10,46,6,1 : Wind Save 
  770.    Border 2,5,7 : Pen 6 : Paper 5
  771.    MISTAKE_DIR:
  772.    Clw : Curs On : Centre "Change Directory to :-"
  773.    Locate 2,2 : Put Key "DF0:" : Input TEMP$;
  774.    X=Instr(TEMP$,":") : If X>4 Then Goto MISTAKE_DIR
  775.    If X=0 Then TEMP$="DF0:"+TEMP$
  776.    If Not Exist(TEMP$) Then Goto MISTAKE_DIR
  777.    Dir$=TEMP$ : Wind Close 
  778.    CONT_DIR:
  779.    Screen 1 : Wind Save : Wind Open 7,30,10,74,28,1 : Wind Save 
  780.    Curs Off : Border 2,2,1 : Pen 6 : Paper 2 : Clw : Dir Dir$
  781.    Pen 7 : Print : Print At(0,)+"Free Disc Space :-"+Str$(Dfree)+" bytes."
  782.    Pen 3 : Print : Print At(20,)+"--  Press a Mouse Key  --";
  783.    While Mouse Key : Wend 
  784.    Repeat : Until Mouse Key
  785.    Wind Close 
  786. End Proc
  787. Procedure FLE_KILL
  788.    KFILE:
  789.    F$=Fsel$("*.fru","","Purge a file from Disc","YOU CANNOT RECOVER PURGED FILES")
  790.    If F$="" Then Pop Proc
  791.    If Left$(F$,1)="*"
  792.       ALERT["Pattern NOT acceptable","","Please try again !!",-1]
  793.       Goto KFILE
  794.    End If 
  795.    If Right$(F$,4)<>".fru"
  796.       ALERT["To protect ALL OTHER files - only","FORMS REALLY UNLIMITED","files may be PURGED",-1]
  797.       Goto KFILE
  798.    End If 
  799.    PURGENAME$=F$
  800.    If Not Exist(PURGENAME$)
  801.       ALERT[PURGENAME$+" does NOT exist","","Please try again",-1]
  802.       Goto KFILE
  803.    End If 
  804.    QUERY["","ARE YOU SURE ??"," NO "," YES "]
  805.    If Param<>2 Then Pop Proc
  806.    INFO_ON["Purging :- "+PURGENAME$,""]
  807.    Change Mouse 3
  808.    Kill PURGENAME$
  809.    Change Mouse 1
  810.    INFO_OFF
  811. End Proc
  812. Procedure FLE_RENAME
  813.    RFILE:
  814.    F$=Fsel$("*.*","","FORMS REALLY UNLIMITED","RENAME a FILE")
  815.    If F$="" Then Pop Proc
  816.    If Instr(F$,"*")>0
  817.       ALERT["YOU CANNOT RENAME A PATTERN","","Please enter a Filename !!",-1]
  818.       Goto RFILE
  819.    End If 
  820.    If Not Exist(F$) Then Goto RFILE
  821.    Wind Save : Wind Open 6,140,100,50,10,1 : Wind Save 
  822.    Border 1,5,7 : Paper 5 : Pen 6 : Clw 
  823.    Print : Centre "RENAME A FILE" : Print : Print 
  824.    Print "  Change :- ";F$ : Print 
  825.    CX=Instr(F$,".") : C$=Left$(F$,CX-1)
  826.    Put Key C$+".bak" : Input "      To :- ";C$
  827.    If C$="" Then Wind Close : Pop Proc
  828.    Rename F$ To C$
  829.    Wind Close 
  830. End Proc
  831. '************************************************  Menu 3 Options
  832. Procedure INP_BOX
  833.    Change Mouse 2
  834.    Inverse Off 
  835.    CHARACTER_PRINT
  836.    While Mouse Key : Wend 
  837.    MEN=0 : ITEM=0 : CH=2
  838.    While(MEN=0 and ITEM=0 and CH=2)
  839.       SET_BOX
  840.       SHAPE_BOX
  841.       MEN=Choice(1)
  842.       ITEM=Choice(2)
  843.       CH=Mouse Click
  844.    Wend 
  845.    Change Mouse 1
  846.    Inverse On 
  847.    CHARACTER_PRINT
  848. End Proc
  849. Procedure INP_LINE
  850.    Change Mouse 2
  851.    Inverse Off 
  852.    CHARACTER_PRINT
  853.    While Mouse Key : Wend 
  854.    MEN=0 : ITEM=0 : CH=2
  855.    While(MEN=0 and ITEM=0 and CH=2)
  856.       SET_LINE
  857.       SHAPE_LINE
  858.       MEN=Choice(1)
  859.       ITEM=Choice(2)
  860.       CH=Mouse Click
  861.    Wend 
  862.    Change Mouse 1
  863.    Inverse On 
  864.    CHARACTER_PRINT
  865. End Proc
  866. Procedure INP_LENGTH
  867.    REDO_PARAMETERS
  868.    If(YPOS+SPOS)>UPPER_LIMIT
  869.       YPOS=0 : SPOS=0
  870.       Cls : Inverse Off 
  871.       For Z=0 To 30
  872.          Print Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH);
  873.       Next Z
  874.    End If 
  875. End Proc
  876. Procedure INP_CLEAR
  877.    QUERY["Clear an area of this FORM ?"," "," Yes Please "," No Thanks "]
  878.    If Param<>1 Then Pop Proc
  879.    Change Mouse 2
  880.    Inverse Off 
  881.    CHARACTER_PRINT
  882.    While Mouse Key : Wend 
  883.    MEN=0 : ITEM=0 : CH=2
  884.    While MEN=0 and ITEM=0
  885.       SET_BOX
  886.       CLR_BOX
  887.       MEN=Choice(1)
  888.       ITEM=Choice(2)
  889.    Wend 
  890.    Inverse On 
  891.    Change Mouse 1
  892. End Proc
  893. Procedure INP_JUSTIFY
  894.    Locate 1,31 : Inverse On : Print Space$(78); : Inverse Off 
  895.    Locate 15,31 : Print "   Highlight the Line of Text to be Justified   ";
  896.    CHARACTER_PRINT
  897.    CONT_JUST:
  898.    While Mouse Key : Wend 
  899.    MEN=0 : ITEM=0 : CH=2
  900.    While MEN=0 and ITEM=0
  901.       CX1=0 : CX2=0
  902.       Repeat 
  903.          If Mouse Key=1
  904.             CX1=X Text(X Screen(X Mouse))
  905.             If CX1<0 : CX1=0 : End If 
  906.             If CX1>79 : CX1=79 : End If 
  907.             CY1=Y Text(Y Screen(Y Mouse))
  908.             If CY1<0 : CY1=0 : End If 
  909.             If CY1>SCR_LIMIT : CY1=SCR_LIMIT : End If 
  910.             CX2=CX1
  911.             Inverse On 
  912.             Locate CX1,CY1
  913.             Print Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX1+1,1);
  914.             Inverse On 
  915.             While Mouse Key=1
  916.                Locate CX2,CY1 : Inverse On 
  917.                Print Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX2+1,1);
  918.                CX2=X Text(X Screen(X Mouse))
  919.                If CX2<0 : CX2=0 : End If 
  920.                If CX2>79 : CX2=79 : End If 
  921.                Locate CX2,CY1
  922.                Print Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX2+1,1);
  923.                If(CX2<79 and CX2>CX1)
  924.                   Locate CX2+1,CY1 : Inverse Off 
  925.                   Print Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX2+2,1);
  926.                End If 
  927.             Wend 
  928.             GRABBED=True
  929.             Inverse Off 
  930.             If CX1>CX2 : Swap CX1,CX2 : End If 
  931.          End If 
  932.       Until GRABBED
  933.       XPOS=CX1 : YPOS=CY1
  934.       Locate XPOS,YPOS
  935.       Inverse On 
  936.       A$=Mid$(LINE$,(CY1+SPOS)*SCR_WIDTH+CX1+1,CX2-CX1+1)
  937.       Print A$;
  938.       Inverse Off : PART=False
  939.       For Z=1 To Len(A$)
  940.          X=Asc(Mid$(A$,Z,1))
  941.          If(X>135 and X<147) : PART=True : End If 
  942.       Next Z
  943.       If PART
  944.          ALERT["CANNOT JUSTIFY BOXES","","or even parts of Boxes",-1]
  945.          Locate XPOS,YPOS : Print A$;
  946.          Pop Proc
  947.       End If 
  948.       CONFIRM_QUERY["Left","Centre","Right","JUSTIFY TEXT"]
  949.       ANSW=Param+1 : JUSTIFY_LINE[A$,ANSW]
  950.       MEN=Choice(1) : ITEM=Choice(2)
  951.    Wend 
  952.    Inverse On 
  953.    CHARACTER_PRINT
  954. End Proc
  955. '************************************************  Menu 4 Options
  956. Procedure PRT_PRINT
  957.    Dim PRT$(10)
  958.    Inverse Off 
  959.    If Not Exist(":Param.fle")
  960.       INFO_ON["Printer Data File does not exist","Please set up as follows :-"]
  961.       For Z=0 To 32000 : Next Z
  962.       INFO_OFF
  963.       PRT_CH_PRINTER
  964.    End If 
  965.    PX=0
  966.    Open In 1,":Param.fle"
  967.    While Not Eof(1)
  968.       Input #1,PRT$(PX)
  969.       Inc PX
  970.    Wend 
  971.    Close 1
  972.    INFO_ON["PRINTING IN PROGRESS","Press <Alt-Q> to Quit Printing"]
  973.    Change Mouse 3
  974.    Open Port 9,PRT$(3)
  975.    Print #9,Chr$(27);PRT$(4);
  976.    Print #9,Chr$(27);PRT$(6);
  977.    Print #9,Chr$(27);Left$(PRT$(5),1);Chr$(Val(Right$(PRT$(5),1)));
  978.    Print #9,Chr$(27);"A";Chr$(6);
  979.    For Z=0 To UPPER_LIMIT-1
  980.       TRAP_LINE[Mid$(LINE$,Z*SCR_WIDTH+1,SCR_WIDTH)]
  981.       K$=Inkey$
  982.       Exit If Key State(Key Shift)
  983.    Next Z
  984.    Close 9
  985.    Clear Key : While Key State(Key Shift) : K$=Inkey$ : Wend 
  986.    Clear Key : INFO_OFF : Change Mouse 1
  987. End Proc
  988. Procedure TRAP_LINE[Q$]
  989.    Dim CH$(11),POS(80)
  990.    For Z=0 To 11 : For X=1 To 6 : Read A : CH$(Z)=CH$(Z)+Chr$(A) : Next X : Next Z
  991.    A=0 : B=0 : C=0 : D=0
  992.    E$="" : F$="" : G$=""
  993.    Repeat 
  994.       Inc B
  995.       E$=Mid$(Q$,B,1)
  996.       C=Asc(E$)
  997.       If(C=136 or C=138 or C=139 or C=142 or C=144 or C=145 or C=146) Then POS(B)=1
  998.       If(C>135 and C<147)
  999.          D=D+6
  1000.          G$=G$+CH$(C-135)
  1001.       Else 
  1002.          If D>0
  1003.             F$=F$+Chr$(27)+"K"+Chr$(D mod 256)+Chr$(Int(D/256))+G$+E$
  1004.             D=0
  1005.             G$=""
  1006.          Else 
  1007.             F$=F$+E$
  1008.          End If 
  1009.       End If 
  1010.    Until B=Len(Q$)
  1011.    If D>0 Then F$=F$+Chr$(27)+"K"+Chr$(D mod 256)+Chr$(Int(D/256))+G$
  1012.    E$=Chr$(27)+"K"+Chr$(224)+Chr$(1)
  1013.    For Z=1 To 80
  1014.       If POS(Z)=1
  1015.          E$=E$+CH$(4)
  1016.       Else 
  1017.          E$=E$+CH$(0)
  1018.       End If 
  1019.    Next Z
  1020.    Print #9,F$
  1021.    Print #9,E$
  1022.    Data 0,0,0,0,0,0
  1023.    Data 0,0,15,31,24,24
  1024.    Data 24,24,24,24,24,24
  1025.    Data 24,24,31,15,0,0
  1026.    Data 0,0,255,255,0,0
  1027.    Data 0,0,240,248,24,24
  1028.    Data 24,24,248,240,0,0
  1029.    Data 24,24,31,31,24,24
  1030.    Data 24,24,248,248,24,24
  1031.    Data 0,0,255,255,24,24
  1032.    Data 24,24,255,255,0,0
  1033.    Data 24,24,255,255,24,24
  1034. End Proc
  1035. Procedure PRT_CH_PRINTER
  1036.    Dim A$(10) : PX=0
  1037.    If Not Exist(":Param.fle") Then Goto TERM
  1038.    Open In 1,":Param.fle"
  1039.    While Not Eof(1)
  1040.       Input #1,A$(PX)
  1041.       Inc PX
  1042.    Wend 
  1043.    Close 1
  1044.    TERM:
  1045.    Screen 1 : Wind Save : Wind Open 8,30,10,74,26,1 : Wind Save 
  1046.    Border 2,5,7 : Pen 6 : Paper 5
  1047.    B$="FORMS REALLY UNLIMITED - "+VERSION$ : C$=String$("=",Len(B$))
  1048.    WRONGDIR:
  1049.    Clw : Centre B$ : Print : Centre C$ : Print : Print 
  1050.    Print "MAIN PARAMETERS SETUP :-"
  1051.    Locate 5,6 : Print "Primary Drive : ";A$(0)
  1052.    Locate 34,6 : Print "Primary Folder : ";A$(1)
  1053.    Put Key A$(0)
  1054.    Locate 19,6 : Input TEMP$;
  1055.    If TEMP$="" Then Goto FOLDER
  1056.    If Right$(TEMP$,1)<>":" Then TEMP$=TEMP$+":"
  1057.    If Len(TEMP$)<>4 Then Goto WRONGDIR
  1058.    If Not Exist(TEMP$) Then Goto WRONGDIR
  1059.    A$(0)=TEMP$
  1060.    FOLDER:
  1061.    Put Key A$(1)
  1062.    Locate 49,6 : Input TEMP$;
  1063.    If Not Exist(A$(0)+TEMP$) Then Goto FOLDER
  1064.    A$(1)=TEMP$
  1065.    Dir$=A$(0)+A$(1)
  1066.    Put Key A$(2)
  1067.    Locate 5,9 : Print "Printer Type : ";
  1068.    Locate 18,9 : Input TEMP$;
  1069.    If TEMP$<>"" Then A$(2)=TEMP$
  1070.    Locate 0,12 : Print "SPECIAL CONTROL CODES :- Character(s) ONLY" : Print 
  1071.    Print "PARallel or SERial Connection :- " : Print 
  1072.    Print "Reset/Initialise Printer .... :- " : Print 
  1073.    Print "Language Character Set ...... :- " : Print 
  1074.    Print "Set Line Feed to 7/72 inch .. :- "
  1075.    Put Key A$(3) : Locate 34,14 : Input TEMP$;
  1076.    If TEMP$<>"" Then A$(3)=TEMP$
  1077.    Put Key A$(4) : Locate 34,16 : Input TEMP$;
  1078.    If TEMP$<>"" Then A$(4)=TEMP$
  1079.    Put Key A$(5) : Locate 34,18 : Input TEMP$;
  1080.    If TEMP$<>"" Then A$(5)=TEMP$
  1081.    Put Key A$(6) : Locate 34,20 : Input TEMP$;
  1082.    If TEMP$<>"" Then A$(6)=TEMP$
  1083.    Print : Print : Print At(20,)+"--  Press a Mouse Key  --";
  1084.    Open Out 1,":Param.fle"
  1085.       For Z=0 To 6 : Print #1,A$(Z) : Next Z
  1086.    Close 1
  1087.    While Mouse Key : Wend 
  1088.    Repeat : Until Mouse Key
  1089.    Wind Close 
  1090. End Proc
  1091. '************************************************  End of Program