home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd571 / progs / picinfo / pic_info.amos / pic_info.amosSourceCode
AMOS Source Code  |  1993-12-02  |  22KB  |  725 lines
  1. '==========================================================================  
  2. '========================= PIC_INFO PROGRAM ===============================
  3. '=========================== V.C.Anthony ==================================
  4. '============================== Jan'93 ====================================
  5. '==========================================================================
  6. '
  7. Dim PIC$(21) : Rem For storage of picture file data 
  8. Dim PIC_PRINT$(21) : Rem For storage of Pic Print data
  9. Dim PIC_COLOR$(64) : Rem Pic Colors in hex. RGB Format
  10. '
  11. 'Initial Display Parameters
  12. WDISPLAY=126 : HDISPLAY=44
  13. WODISPLAY=111 : HODISPLAY=27
  14. '
  15. Screen Open 0,640,512,4,Laced+Hires : Flash Off : Curs Off 
  16. Screen Display 0,WDISPLAY,HDISPLAY,,
  17. Palette $0,$288,$800,$F
  18. Screen Hide 0
  19. '
  20. SEARCH_PATH$="Sys:"
  21. MAIN_TITLE$="SELECT PIC FILE TO BE LOADED"
  22. BOTTOM_TITLE$="for display and parameter check"
  23. Proc PIC_FILE_SELECT
  24. '
  25. '
  26. 'check Pic File for parameters and to put data into pic_print$(18) 
  27. Proc PIC_FILE_CHECK
  28. '
  29. Proc PIC_PARAMETERS
  30. '
  31. Proc PIC_SCREEN_DATA
  32. '
  33. Proc PIC_LOAD
  34. '
  35. 'Open Pic Title screen 
  36. Screen Open 2,640,16,2,LACE+Hires
  37. Screen Display 2,WDISPLAY,HDISPLAY,,
  38. Palette $0,$888
  39. '
  40. Proc PIC_TITLE
  41. '
  42. 'SELECTION_LOOP
  43. Repeat 
  44.    '
  45.    'Left Mouse Button pressed 
  46.    If Mouse Key=1 and PIC=1
  47.       Proc PIC_TITLE
  48.       '
  49.       'N Key pressed to Select new Pic File
  50.    Else If Key State(54)
  51.       Screen Close 1 : Screen 2 : Cls 0 : Screen To Back 2 : PIC=0
  52.       Screen To Front 0 : Screen Hide 0 : Screen 0
  53.       GX1=0 : GY1=0 : GX2=0 : GY2=0 : Bell 10
  54.       SEARCH_PATH$="Sys:"
  55.       MAIN_TITLE$="SELECT PIC FILE TO BE LOADED"
  56.       BOTTOM_TITLE$="for display and parameter check"
  57.       Proc PIC_FILE_SELECT : Proc PIC_FILE_CHECK
  58.       Proc PIC_PARAMETERS : Proc PIC_SCREEN_DATA
  59.       Proc PIC_LOAD : Proc PIC_TITLE
  60.       Bell 10
  61.       '
  62.       'SPACE Key pressed To go to PIC Data Screen
  63.    Else If Key State(64)
  64.       Bell 10
  65.       If PIC=1
  66.          PIC=0 : Screen To Back 1 : Screen To Back 2
  67.          Screen To Front 0 : Screen Show 0 : Curs Off : Bell 10
  68.          Screen 0 : Screen Display 0,WDISPLAY,HDISPLAY,, : Rem Any Pic centering ?
  69.          Proc PIC_SCREEN_DATA
  70.       End If 
  71.       '
  72.       'P Key pressed to print Pic Data 
  73.    Else If Key State(25)
  74.       Bell 10 : Proc PIC_PRINT
  75.       '
  76.       'V Key pressed to View PIC 
  77.    Else If Key State(52)
  78.       If PIC=0
  79.          Bell 10 : Screen Hide 0 : Screen To Front 1 : PIC=1
  80.       End If 
  81.       '
  82.       'An Arrow Key is pressed to enable Pic centering inside the View Port
  83.       'or to enable scrolling of a large BitMap inside the View Port 
  84.    Else If Key State(78) or Key State(79) or Key State(76) or Key State(77)
  85.       If PIC=1
  86.          Bell 10 : Proc ARROW_KEY
  87.       End If 
  88.       '
  89.       'T / B Key pressed to set Pic Rectangle for Dump to the printer
  90.    Else If Key State(20) or Key State(53)
  91.       If PIC=0
  92.          Screen Hide 0 : Screen To Front 1 : PIC=1
  93.       End If 
  94.       Screen 1
  95.       While Key State(20) or Key State(53)
  96.          Proc PIC_RUBBER_BAND
  97.       Wend 
  98.       '
  99.       'D Key pressed to Dump Pic Rectangle to Printer
  100.    Else If Key State(34)
  101.       If PIC=0
  102.          Screen Hide 0 : Screen To Front 1 : Screen 1 : PIC=1
  103.       End If 
  104.       Proc PIC_DUMP
  105.       '
  106.       'S KEY PRESSED To Save PIC 
  107.    Else If Key State(33)
  108.       If PIC=1
  109.          Screen To Front 0 : Screen 0
  110.       End If 
  111.       SEARCH_PATH$="Sys:"
  112.       MAIN_TITLE$="SELECT / ENTER PIC NAME TO BE SAVED"
  113.       BOTTOM_TITLE$="as compressed IFF with display parameters"
  114.       Bell 10 : Proc PIC_FILE_SELECT
  115.       Screen To Front 1 : Screen 1
  116.       '
  117.       Save Iff PATH$,1
  118.       '      
  119.       Bell 10
  120.    End If 
  121.    '
  122.    'ESC Key pressed to Exit Program 
  123. Until Key State(69)
  124. Bell 10 : Screen Close 1 : Screen Close 2 : Screen Close 0
  125. End 
  126. '
  127. '
  128. Procedure PIC_FILE_SELECT
  129.    Shared PATH$,PIC$(),SEARCH_PATH$,MAIN_TITLE$,BOTTOM_TITLE$
  130.    Screen Hide 0 : Curs On : Bell 10
  131.    NAME_DEFAULT$=""
  132.    PATH$=Fsel$(SEARCH_PATH$,NAME_DEFAULT$,MAIN_TITLE$,BOTTOM_TITLE$)
  133.    If PATH$=""
  134.       Bell 10 : Screen Close 1 : Screen Close 2 : Screen Close 0
  135.       End 
  136.    End If 
  137.    Curs Off 
  138. End Proc
  139. '
  140. Procedure PIC_FILE_CHECK
  141.    Shared PATH$,NAME$,PIC$(),PIC_PRINT$(),WPIC,HPIC,WVIEW,HVIEW,PIC_COLOR,SIZE
  142.    '
  143.    L=Len(PATH$) : C=L : NAME$="" : C$=""
  144.    Repeat 
  145.       NAME$=C$+NAME$
  146.       C$=Mid$(PATH$,C,1)
  147.       C=C-1
  148.    Until(C$="/") or(C$=":")
  149.    '
  150.    Rem Open Pic File so as to read parameter data from it 
  151.    Open In 1,PATH$
  152.    For FD=1 To 21
  153.       Line Input #1,PIC$(FD)
  154.    Next FD
  155.    Close 1
  156.    '
  157.    If PIC$(1)<>"FORM" : Rem File is not IFF
  158.       PIC_PRINT$(1)=""
  159.    Else 
  160.       PIC_PRINT$(1)=" FORM"
  161.       FD=1
  162.    End If 
  163.    Repeat 
  164.       FD=FD+1
  165.       L=Len(PIC$(FD))
  166.       If L=0
  167.          PIC_PRINT$(FD)=" -"
  168.       Else If L<10
  169.          For C=1 To L
  170.             PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  171.          Next C
  172.       End If 
  173.    Until L>9
  174.    S1=Asc(Left$(PIC$(FD),1)) : S2=Asc(Mid$(PIC$(FD),2,1)) : S3=Asc(Mid$(PIC$(FD),3,1))
  175.    PIC_PRINT$(FD)=Str$(S1)+Str$(S2)
  176.    SIZE=S1*256+S2 : C=2
  177.    If L>10
  178.       PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(S3)
  179.       SIZE=SIZE*256+S3 : C=3
  180.    End If 
  181.    If Mid$(PIC$(FD),C+1,4)="ILBM"
  182.       PIC_PRINT$(FD)=PIC_PRINT$(FD)+" "+Right$(PIC$(FD),8)
  183.    End If 
  184.    If Right$(PIC$(FD),4)<>"BMHD"
  185.       Repeat 
  186.          FD=FD+1
  187.          L=Len(PIC$(FD))
  188.          If L=0
  189.             PIC_PRINT$(FD)=" -"
  190.          Else If L<4
  191.             PIC_PRINT$(FD)=""
  192.             For C=1 To L
  193.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  194.             Next C
  195.          End If 
  196.       Until Right$(PIC$(FD),4)="BMHD"
  197.       PIC_PRINT$(FD)=""
  198.       If L>4
  199.          For C=1 To L-4
  200.             PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  201.          Next C
  202.       End If 
  203.       PIC_PRINT$(FD)=PIC_PRINT$(FD)+" BMHD"
  204.    End If 
  205.    Repeat 
  206.       FD=FD+1
  207.       L=Len(PIC$(FD))
  208.       If L=0
  209.          PIC_PRINT$(FD)=" -"
  210.       End If 
  211.    Until Asc(Left$(PIC$(FD),1))=20
  212.    '
  213.    PIC_PRINT$(FD)=""
  214.    For C=1 To L
  215.       PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  216.    Next C
  217.    '
  218.    'Evaluate Pic Bit Map Width and Height 
  219.    '------------------------------------- 
  220.    If L=2
  221.       A=Asc(Right$(PIC$(FD),1))
  222.       If A=1 or A=2 or A=3
  223.          WPIC=A*256
  224.       Else 
  225.          WPIC=A
  226.       End If 
  227.    Else If L=3
  228.       A=Asc(Mid$(PIC$(FD),2,1)) : B=Asc(Right$(PIC$(FD),1))
  229.       WPIC=A*256+B
  230.    Else If L=4
  231.       A=Asc(Mid$(PIC$(FD),2,1)) : B=Asc(Mid$(PIC$(FD),3,1))
  232.       C=Asc(Right$(PIC$(FD),1))
  233.       WPIC=A*256+B
  234.       If C<10
  235.          HPIC=C*256
  236.       Else 
  237.          HPIC=C
  238.       End If 
  239.       Goto FINISH_PIC_BITMAP
  240.    Else If L>4
  241.       A=Asc(Mid$(PIC$(FD),L-3,1)) : B=Asc(Mid$(PIC$(FD),L-2,1))
  242.       C=Asc(Mid$(PIC$(FD),L-1,1)) : D=Asc(Right$(PIC$(FD),1))
  243.       WPIC=A*256+B
  244.       HPIC=C*256+D
  245.       Goto FINISH_PIC_BITMAP
  246.    End If 
  247.    '
  248.    FD=FD+1
  249.    PIC_PRINT$(FD)=""
  250.    For C=1 To L
  251.       PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  252.    Next C
  253.    L=Len(PIC$(FD))
  254.    If L=1
  255.       A=Asc(PIC$(FD))
  256.       If A=1 or A=2 or A=3
  257.          HPIC=A*256
  258.       Else 
  259.          HPIC=A
  260.       End If 
  261.    Else If L>1
  262.       A=Asc(Mid$(PIC$(FD),L-1,1)) : B=Asc(Right$(PIC$(FD),1))
  263.       HPIC=A*256+B
  264.    End If 
  265.    FINISH_PIC_BITMAP:
  266.    '----------------- 
  267.    '
  268.    PIC_COLOR=0
  269.    Repeat 
  270.       FD=FD+1 : L=Len(PIC$(FD))
  271.       If L=0
  272.          PIC_PRINT$(FD)=" -"
  273.       Else If L>0
  274.          If PIC_COLOR=0
  275.             PIC_COLOR=Asc(Left$(PIC$(FD),1))
  276.          End If 
  277.          If L<4
  278.             PIC_PRINT$(FD)=""
  279.             For C=1 To L
  280.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  281.             Next C
  282.          Else If L>3
  283.             A$=Right$(PIC$(FD),4)
  284.             If(A$<>"CMAP") and(A$<>"CAMG")
  285.                PIC_PRINT$(FD)=""
  286.                For C=1 To L
  287.                   PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  288.                Next C
  289.             Else If(A$="CMAP") or(A$="CAMG")
  290.                PIC_PRINT$(FD)=""
  291.                For C=1 To L-4
  292.                   PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  293.                Next C
  294.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+" "+A$
  295.                '
  296.                'Evaluate View Port Width and Height 
  297.                '------------------------------------------------------------- 
  298.                If L=4
  299.                   CHECK=FD-1 : CHAR=0
  300.                Else If L=5
  301.                   A=Asc(Left$(PIC$(FD),1))
  302.                   If A=200 or A=1 or A=2
  303.                      If A=200
  304.                         HVIEW=200
  305.                      Else If A=1 or A=2
  306.                         HVIEW=A*256
  307.                      End If 
  308.                      L=Len(PIC$(FD-1))
  309.                      WVIEW=Asc(Mid$(PIC$(FD-1),L-1,1))*256+Asc(Right$(PIC$(FD-1),1))
  310.                      Goto CHECK_FINISH
  311.                   Else 
  312.                      CHECK=FD-1 : CHAR=0
  313.                   End If 
  314.                Else If L>7
  315.                   CHECK=FD : CHAR=4
  316.                End If 
  317.                L=Len(PIC$(CHECK))
  318.                A1=Asc(Mid$(PIC$(CHECK),L-CHAR-3,1)) : A2=Asc(Mid$(PIC$(CHECK),L-CHAR-2,1))
  319.                A3=Asc(Mid$(PIC$(CHECK),L-CHAR-1,1)) : A4=Asc(Mid$(PIC$(CHECK),L-CHAR,1))
  320.                If A2=1 or A2=2
  321.                   WVIEW=A2*256+A3
  322.                   If A4=1 or A4=2
  323.                      HVIEW=A4*256
  324.                   Else 
  325.                      HVIEW=A4
  326.                   End If 
  327.                Else If A2>2
  328.                   WVIEW=A1*256+A2
  329.                   HVIEW=A3*256+A4
  330.                End If 
  331.                CHECK_FINISH:
  332.             End If 
  333.          End If 
  334.       End If 
  335.    Until(A$="CMAP") or(A$="CAMG") or(FD=21)
  336.    If(A$<>"CMAP") and(FD<21)
  337.       Repeat 
  338.          FD=FD+1 : L=Len(PIC$(FD))
  339.          If L=0
  340.             PIC_PRINT$(FD)=" -"
  341.          Else If L<4
  342.             PIC_PRINT$(FD)=""
  343.             For C=1 To L
  344.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  345.             Next C
  346.          Else If L>3
  347.             B$=Right$(PIC$(FD),4)
  348.             If B$="CMAP"
  349.                PIC_PRINT$(FD)=""
  350.                For C=1 To L-4
  351.                   PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  352.                Next C
  353.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+" "+B$
  354.             Else 
  355.                PIC_PRINT$(FD)=""
  356.                For C=1 To L
  357.                   PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  358.                Next C
  359.             End If 
  360.          End If 
  361.       Until(B$="CMAP") or(FD=21)
  362.    End If 
  363.    If FD<21
  364.       Repeat 
  365.          FD=FD+1 : L=Len(PIC$(FD))
  366.          If L=0
  367.             PIC_PRINT$(FD)=" -"
  368.          Else If L>0
  369.             If L>18
  370.                L=18
  371.             End If 
  372.             PIC_PRINT$(FD)=""
  373.             For C=1 To L
  374.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+Str$(Asc(Mid$(PIC$(FD),C,1)))
  375.             Next C
  376.             If L=18
  377.                PIC_PRINT$(FD)=PIC_PRINT$(FD)+" + MORE"
  378.             End If 
  379.          End If 
  380.       Until FD=21
  381.    End If 
  382. End Proc
  383. '
  384. Procedure PIC_PARAMETERS
  385.    Shared PIC$,PIC_COLOR,WPIC,HPIC,WVIEW,HVIEW,WRES$,HRES$
  386.    Shared OVERSCAN,OVERSCAN$,HAM$
  387.    If PIC_COLOR<6
  388.       PIC_COLOR=2^PIC_COLOR : HAM$="" : Rem Convert bit planes to no. of colors
  389.    Else If PIC_COLOR=6
  390.       PIC_COLOR=4096 : HAM$="HAM "
  391.    End If 
  392.    OVERSCAN=0 : OVERSCAN$="" : WRES$="" : HRES$=""
  393.    If WVIEW<640
  394.       WRES$="LOWRES"
  395.    Else If WVIEW>639
  396.       WRES$="HIRES"
  397.    End If 
  398.    If HVIEW<512
  399.       HRES$="PAL"
  400.       If HVIEW=200
  401.          HRES$="NTSC"
  402.       Else If HVIEW=400
  403.          HRES$="LACED NTSC"
  404.       End If 
  405.    Else If HVIEW>511
  406.       HRES$="LACED PAL"
  407.    End If 
  408.    PIC$=""
  409.    If WPIC=WVIEW and HPIC=HVIEW
  410.       If WVIEW=320 or WVIEW=640
  411.          If HVIEW=256 or HVIEW=200 or HVIEW=400 or HVIEW=512
  412.             OVERSCAN=0 : PIC$="PIC"
  413.          End If 
  414.       Else If WVIEW>320 and WVIEW<353
  415.          If HVIEW>256 and HVIEW<284
  416.             OVERSCAN=1 : PIC$="PIC"
  417.          Else If HVIEW>512 and HVIEW<567
  418.             OVERSCAN=1 : PIC$="PIC"
  419.          End If 
  420.       Else If WVIEW>256 and WVIEW<705
  421.          If HVIEW>256 and HVIEW<284
  422.             OVERSCAN=1 : PIC$="PIC"
  423.          Else If HVIEW>512 and HVIEW<567
  424.             OVERSCAN=1 : PIC$="PIC"
  425.          End If 
  426.       End If 
  427.       If PIC$=""
  428.          OVERSCAN=2 : PIC$="PIC"
  429.       End If 
  430.    End If 
  431.    If PIC$=""
  432.       If WPIC<WVIEW or HPIC<HVIEW
  433.          OVERSCAN=0 : PIC$="BRUSH"
  434.       Else If WPIC>WVIEW or HPIC>HVIEW
  435.          If WVIEW=320 or WVIEW=640
  436.             OVERSCAN=0 : PIC$="BITMAP"
  437.          Else 
  438.             OVERSCAN=1 : PIC$="BITMAP"
  439.          End If 
  440.       End If 
  441.    End If 
  442.    If OVERSCAN=1
  443.       OVERSCAN$="OVERSCAN"
  444.    Else If OVERSCAN=2
  445.       OVERSCAN$="MAX OVERSCAN"
  446.    Else If OVERSCAN=0
  447.       OVERSCAN$=""
  448.    End If 
  449.    '
  450.    '
  451. End Proc
  452. '
  453. Procedure PIC_SCREEN_DATA
  454.    'Print Pic Data on Screen 0  
  455.    Shared PIC_PRINT$(),PIC_COLOR$(),PIC_COLOR$,PIC_COLOR,PIC$,WPIC,HPIC
  456.    Shared PATH$,WVIEW,HVIEW,SIZE,PIC_COLOR,OVERSCAN$,HAM$,WRES$,HRES$
  457.    Shared GX1,GY1,GX2,GY2
  458.    If GX2=0 and GY2=0
  459.       GX1=0 : GY1=0 : GX2=WVIEW-1 : GY2=HVIEW-1
  460.    End If 
  461.    Screen 0 : Cls 1
  462.    Locate 1,1 : Pen 2 : Paper 1 : Print "V = VIEW PIC."
  463.    Locate 1,2 : Print "D = DUMP PIC TO PRT"
  464.    Locate 1,3 : Print "S = SAVE PIC"
  465.    Locate 1,4 : Print "N = NEW PIC"
  466.    Locate 65,1 : Print "P = PRINT DATA"
  467.    Locate 63,2 : Print "ESC = END PROG."
  468.    Locate 61,3 : Print "SPACE = PIC DATA"
  469.    Locate 54,4 : Print "T,B + ARROWS = PIC RECT."
  470.    Locate 1,6 : Print "IN VIEW MODE PRESSING ARROW KEYS ONLY SCROLLS A LARGE PIC BITMAP ACROSS SCREEN"
  471.    Locate 1,8 : Print "IN VIEW MODE SHIFT + ARROW KEYS ENABLE PIC CENTERING INSIDE VIEW PORT"
  472.    Pen 3
  473.    Locate 1,10 : Print "DUMP RECTANGLE =";(GX2-GX1+1);" *";(GY2-GY1+1);" / TOP LEFT =";GX1;",";GY1;" / BOTTOM RIGHT =";GX2;",";GY2
  474.    Pen 2
  475.    Locate 1,12 : Print "IN VIEW MODE PRESS T / B KEY TO SIZE TOP LEFT / BOTTOM RIGHT CORNER"
  476.    Locate 1,14 : Print "WHILE PRESSING T / B KEY USE ARROW KEYS TO SIZE PIC RECTANGLE FOR PRINTER DUMP"
  477.    Locate 30,1 : Print "PIC_INFO DATA SCREEN"
  478.    Locate 30,2 : Print "--------------------"
  479.    Locate 31,3 : Pen 0 : Print "V.C.Anthony Jan'93"
  480.    Locate 1,16 : Print PATH$;" = ";WRES$;" ";OVERSCAN$;" ";HRES$
  481.    Locate 1,18 : Print PIC$;" =";WPIC;" *";HPIC;"  View Port =";WVIEW;" *";HVIEW;" / ";HAM$;PIC_COLOR;" COLORS";" /";SIZE;" Bytes"
  482.    Locate 1,21 : Print "COMPUTER ENHANCED FIRST 21 PIC FILE DATA LINES"
  483.    Locate 1,22 : Print "----------------------------------------------"
  484.    For FD=1 To 21
  485.       Locate 0,FD+22 : Print PIC_PRINT$(FD)
  486.    Next FD
  487.    If PIC_COLOR<4096
  488.       Print : Print " COLOR VALUES IN HEX. RGB FORMAT"
  489.       Print " -------------------------------"
  490.       For C=0 To PIC_COLOR-1
  491.          Print " COLOR";C;" = ";PIC_COLOR$(C);
  492.          If((C+1)/4)*4=C+1
  493.             Print 
  494.          Else 
  495.             Print " , ";
  496.          End If 
  497.       Next C
  498.    End If 
  499. End Proc
  500. '
  501. Procedure PIC_LOAD
  502.    Shared PATH$,PIC_COLOR$(),PIC_COLOR$,PIC_COLOR,OVERSCAN,WVIEW,HVIEW,PIC
  503.    Shared WDISPLAY,HDISPLAY,WODISPLAY,HODISPLAY,PIC$,PIC_NOSCAN,PIC_OVERSCAN
  504.    Shared HAM$
  505.    Curs Off 
  506.    '
  507.    Load Iff PATH$,1 : PIC=1 : Rem Load pic and open Screen 1 
  508.    '
  509.    'Position Screen View Port (Centre Pic)
  510.    If OVERSCAN=0
  511.       Screen Display 1,WDISPLAY,HDISPLAY,WVIEW,HVIEW
  512.    Else If OVERSCAN>0
  513.       Screen Display 1,WODISPLAY,HODISPLAY,WVIEW,HVIEW
  514.    End If 
  515.    '
  516.    'Evaluate Pic Colors in hex values 
  517.    Screen 1
  518.    If PIC_COLOR=4096
  519.       PIC_COLOR=Screen Colour : Rem to correct if necessary for half bright
  520.       If PIC_COLOR<65
  521.          HAM$=""
  522.       End If 
  523.    End If 
  524.    If PIC_COLOR<65
  525.       PIC_COLOR$="YES"
  526.       For C=0 To PIC_COLOR-1
  527.          PIC_COLOR$(C)=Hex$(Colour(C),3)
  528.       Next C
  529.    Else 
  530.       PIC_COLOR$=""
  531.    End If 
  532. End Proc
  533. '
  534. Procedure PIC_TITLE
  535.    Shared PATH$,NAME$,PIC_COLOR$,PIC_COLOR$(),PIC_COLOR,PIC,WPIC,HPIC,WVIEW,HVIEW
  536.    Shared OVERSCAN,OVERSCAN$,HAM$,PIC$,WRES$,HRES$,WDISPLAY,HDISPLAY
  537.    Screen To Front 2 : Screen 2 : Bell 10
  538.    Screen Display 2,WDISPLAY,HDISPLAY,, : Rem Any Pic centering ?
  539.    Curs Off : Cls 1 : Pen 0 : Paper 1
  540.    Locate 0,0 : Centre "ESC=END;SPACE=PIC DATA;P=PRINT;DATA;V=VIEW PIC;D=DUMP PIC;S=SAVE PIC;N=NEW PIC"
  541.    Locate 0,1 : Centre Left$(NAME$,16)+Str$(WPIC)+" *"+Str$(HPIC)+" VIEW ="+Str$(WVIEW)+" *"+Str$(HVIEW)+" "+OVERSCAN$+Str$(PIC_COLOR)+" COL "+WRES$+" "+HRES$
  542.    
  543.    While Mouse Key=1
  544.    Wend 
  545.    Screen To Front 1 : Screen 1 : Bell 10
  546. End Proc
  547. '
  548. Procedure PIC_PRINT
  549.    Shared PIC_PRINT$(),PIC_COLOR$(),PIC_COLOR,PIC$,SIZE,WVIEW,HVIEW
  550.    Shared PATH$,PIC$,WRES$,HRES$,HAM$,PIC_COLOR$,WPIC,HPIC,GX1,GY1,GX2,GY2
  551.    Lprint " V = VIEW PIC                PIC_INFO PROGRAM                N = NEW PIC"
  552.    Lprint " P = DUMP PIC RECT.          ----------------                P = PRINT PIC DATA"
  553.    Lprint " S = SAVE PIC                V.C.Anthony Jan'93            ESC = END PROG."
  554.    Lprint " SPACE = PIC DATA                                 T,B + ARROWS = PIC RECT."
  555.    Lprint 
  556.    Lprint " "+PATH$;" = ";WRES$;" ";OVERSCAN$;" "+HRES$
  557.    Lprint 
  558.    Lprint " ";PIC$;" =";WPIC;" *";HPIC;" / View Port =";WVIEW;" *";HVIEW;" / ";HAM$;PIC_COLOR;" COLORS";" / File =";SIZE;" Bytes"
  559.    Lprint 
  560.    Lprint "IN VIEW MODE PRESSING ARROW KEYS SCROLLS A LARGE PIC BITMAP ACROSS VIEW PORT"
  561.    Lprint "IN VIEW MODE PRESSING SHIFT + ARROW KEYS CENTERS PIC ON SCREEN"
  562.    Lprint 
  563.    Lprint "DUMP RECTANGLE =";(GX2-GX1+1);" *";(GY2-GY1+1);" / TOP LEFT =";GX1;",";GY1;" / BOTTOM RIGHT =";GX2;",";GY2
  564.    Lprint 
  565.    Lprint "IN VIEW PIC MODE PRESS T / B KEYS TO SIZE TOP LEFT / BOTTOM RIGHT CORNER"
  566.    Lprint "WHILE PRESSING T / B KEYS USE ARROW KEYS TO SIZE PIC RECTANGLE FOR PRINTER DUMP"
  567.    Lprint 
  568.    Lprint " COMPUTER ENHANCED FIRST 21 PIC FILE DATA LINES"
  569.    Lprint " ----------------------------------------------"
  570.    For FD=1 To 21
  571.       Lprint PIC_PRINT$(FD)
  572.    Next FD
  573.    Lprint 
  574.    If PIC_COLOR<65
  575.       Lprint " PIC COLOUR VALUES IN HEX. RGB FORMAT"
  576.       Lprint " ------------------------------------"
  577.       For C=0 To PIC_COLOR-1
  578.          Lprint " ";"COLOR";C;" = ";PIC_COLOR$(C);
  579.          If((C+1)/4)*4=C+1
  580.             Lprint 
  581.          Else 
  582.             Lprint " /";
  583.          End If 
  584.       Next C
  585.    End If 
  586.    Lprint Chr$(12) : Rem Form Feed
  587. End Proc
  588. '
  589. Procedure ARROW_KEY
  590.    Shared WDISPLAY,HDISPLAY,WODISPLAY,HODISPLAY,PIC$,WPIC,HPIC,WOFFSET,HOFFSET
  591.    Shared WVIEW,HVIEW,OVERSCAN
  592.    W=0 : H=0
  593.    If Key State(78) : Rem Right Arrow Key
  594.       W=1
  595.    Else If Key State(79) : Rem Left Arrow Key 
  596.       W=-1
  597.    Else If Key State(76) : Rem Up Arrow Key 
  598.       H=-1
  599.    Else If Key State(77) : Rem Down Arrow 
  600.       H=1
  601.    End If 
  602.    '
  603.    'Shift Key is not pressed for Scrolling a large BitMap across View Port
  604.    If PIC$="BITMAP" and Key Shift=0
  605.       WOFFSET=WOFFSET+W : HOFFSET=HOFFSET+H
  606.       If WOFFSET<0
  607.          WOFFSET=0
  608.       Else If WOFFSET>WPIC-WVIEW
  609.          WOFFSET=WPIC-WVIEW
  610.       End If 
  611.       If HOFFSET<0
  612.          HOFFSET=0
  613.       Else If HOFFSET>HPIC-HVIEW
  614.          HOFFSET=HPIC-HVIEW
  615.       End If 
  616.       Screen Offset 1,WOFFSET,HOFFSET
  617.       '
  618.       'Left Shift Key pressed to select centering Pic inside View Port 
  619.    Else If Key Shift=1
  620.       If OVERSCAN=0
  621.          WDISPLAY=WDISPLAY+W*16 : HDISPLAY=HDISPLAY+H
  622.          Screen 1 : Screen Display 1,WDISPLAY,HDISPLAY,WVIEW,HVIEW
  623.       Else If OVERSCAN>0
  624.          WODISPLAY=WODISPLAY+W*16 : HODISPLAY=HODISPLAY+H
  625.          Screen Display 1,WODISPLAY,HODISPLAY,WVIEW,HVIEW
  626.       End If 
  627.       Wait 25
  628.    End If 
  629. End Proc
  630. '
  631. '
  632. Procedure PIC_RUBBER_BAND
  633.    Shared WVIEW,HVIEW,GX1,GY1,GX2,GY2
  634.    Pen 1 : Paper 0 : Curs Off 
  635.    If GX2=0 and GY2=0
  636.       GX1=0 : GY1=0
  637.       GX2=WVIEW-1 : GY2=HVIEW-1
  638.    End If 
  639.    Screen To Front 2 : Screen 2 : Cls 1 : Gr Writing 1
  640.    PIC_WIDTH=GX2-GX1+1 : PIC_HEIGHT=GY2-GY1+1
  641.    T1$="DUMP RECTANGLE : LEFT TOP ="+Str$(GX1)+","+Str$(GY1)+"  /  RIGHT BOTTOM ="+Str$(GX2)+","+Str$(GY2)
  642.    T2$=Space$(16)+"WIDTH ="+Str$(PIC_WIDTH)+" PIXELS  /  HEIGHT ="+Str$(PIC_HEIGHT)+" PIXELS"
  643.    Locate 0,0 : Centre T1$
  644.    Locate 0,1 : Centre T2$
  645.    Repeat 
  646.       If Key State(20)=False and Key State(53)=False
  647.          Exit 
  648.       End If 
  649.    Until Key State(76) or Key State(77) or Key State(78) or Key State(79)
  650.    PRESSED_KEY=0
  651.    While Key State(76) or Key State(77) or Key State(78) or Key State(79)
  652.       If PRESSED_KEY=0
  653.          Screen To Front 1 : Screen 1 : Gr Writing 2 : Rem XOR Writing Mode 
  654.          PRESSED_KEY=1 : Bell 10
  655.       End If 
  656.       If Key State(20) : Rem Key T pressed - Left Corner adjustment 
  657.          If Key State(78)
  658.             GX1=GX1+1
  659.          Else If Key State(79)
  660.             GX1=GX1-1
  661.             If GX1<0
  662.                GX1=0
  663.             End If 
  664.          Else If Key State(77)
  665.             GY1=GY1+1
  666.          Else If Key State(76)
  667.             GY1=GY1-1
  668.             If GY1<0
  669.                GY1=0
  670.             End If 
  671.          End If 
  672.       Else If Key State(53)
  673.          If Key State(78)
  674.             GX2=GX2+1
  675.             If GX2>WVIEW-1
  676.                GX2=WVIEW-1
  677.             End If 
  678.          Else If Key State(79)
  679.             GX2=GX2-1
  680.          Else If Key State(77)
  681.             GY2=GY2+1
  682.             If GY2>HVIEW-1
  683.                GY2=HVIEW-1
  684.             End If 
  685.          Else If Key State(76)
  686.             GY2=GY2-1
  687.          End If 
  688.       End If 
  689.       Box GX1,GY1 To GX2,GY2
  690.       Wait 2
  691.       Box GX1,GY1 To GX2,GY2
  692.    Wend 
  693.    Screen To Front 1 : Screen 1
  694.    Gr Writing 1 : MK=0 : MZ=0 : Clear Key : Bell 10
  695.    Bell 10
  696. End Proc
  697. '
  698. Procedure PIC_DUMP
  699.    Shared GX1,GY1,GX2,GY2
  700.    Printer Open 
  701.    '
  702.    'Loop until printer is online ready for use or ESC Key pressed to Abort
  703.    K$=""
  704.    Repeat 
  705.       Bell 10 : Wait 50
  706.       K$=Inkey$
  707.       If K$=Chr$(27)
  708.          Exit 
  709.       End If 
  710.    Until Printer Online
  711.    If K$=Chr$(27)
  712.       Goto FINISH_PIC_DUMP
  713.    End If 
  714.    K$=""
  715.    '
  716.    Printer Dump GX1,GY1 To GX2,GY2
  717.    '    
  718.    'Loop while Printer is busy - pic screen must stay in place during Dump  
  719.    Repeat 
  720.    Until Printer Check
  721.    '
  722.    FINISH_PIC_DUMP:
  723.    Printer Close : Bell 10
  724. End Proc
  725. '