home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / developmen / oplexamp / OPLEXAM.TXT < prev    next >
Text File  |  1993-10-27  |  37KB  |  1,583 lines
  1. 1: Creating and running programs
  2.  
  3. 2: Variables and constants
  4.  
  5. 3: Loops and branches
  6.  
  7. 4: Calling procedures
  8.  
  9. 5: Data file handling
  10.  
  11. PROC openfile:
  12.   IF NOT EXIST("example")
  13.     CREATE "example",A,int%,lng&,fp,str$
  14.   ELSE
  15.     OPEN "example",A,int%,lng&,fp,str$
  16.   ENDIF
  17.   PRINT "Current values:"
  18.   show:
  19.   PRINT "Assigning values"
  20.   A.int%=1
  21.   A.lng&=&2**20   REM the 1st & avoids integer overflow
  22.   A.fp=SIN(PI/6)
  23.   PRINT "Give a value for the string:"
  24.   INPUT A.str$
  25.   PRINT "New values:"
  26.   show:
  27. ENDP
  28.  
  29. PROC show:
  30.   PRINT "integer=";A.int%
  31.   PRINT "long=";A.lng&
  32.   PRINT "float=";A.fp
  33.   PRINT "string=";A.str$
  34.   GET
  35. ENDP
  36.  
  37. PROC count:
  38.   LOCAL reply%
  39.   OPEN "example",A,f%,f&,f,f$
  40.   DO
  41.     CLS
  42.     AT 20,1 :PRINT "Record count=";COUNT
  43.     AT 9,5 :PRINT "(A)dd a record"
  44.     AT 9,7 :PRINT "(Q)uit"
  45.     reply%=GET
  46.     IF reply%=%q OR reply%=%Q
  47.       BREAK
  48.     ELSEIF reply%=%A OR reply%=%a
  49.       add:
  50.     ELSE
  51.       BEEP 16,250
  52.     ENDIF
  53.   UNTIL 0
  54. ENDP
  55.  
  56. PROC add:
  57.   CLS
  58.   PRINT "Enter integer field:";
  59.   INPUT A.f%
  60.   PRINT "Enter long integer field:";
  61.   INPUT A.f&
  62.   PRINT "Enter numeric field:";
  63.   INPUT A.f
  64.   PRINT "Enter string field:";
  65.   INPUT A.f$
  66.   APPEND
  67. ENDP
  68.  
  69. FIRST
  70. WHILE FIND("*BROWN*")
  71.   PRINT a.name$, a.phone$
  72.   NEXT
  73.   GET
  74. ENDWH
  75.  
  76. PROC copyrec:
  77.   OPEN "example",A,f%,f&,f,f$
  78.   TRAP DELETE "temp"
  79.   REM If file doesn't exist, ignore error
  80.   CREATE "temp",B,f%,f&,f,f$
  81.   PRINT "Copying EXAMPLE to TEMP"
  82.   USE A REM the EXAMPLE file
  83.   DO
  84.     IF a.f%>30 and a.f<3.1415
  85.       b.f%=a.f%
  86.       b.f&=a.f&
  87.       b.f=a.f
  88.       b.f$="Selective copy"
  89.       USE B REM the TEMP file
  90.       APPEND
  91.       USE A
  92.     ENDIF
  93.     NEXT
  94.   UNTIL EOF REM until End Of File
  95.   CLOSE REM closes A; B becomes current
  96.   CLOSE REM closes B
  97. ENDP
  98.  
  99. p%=PEEKW($1c)+$1e
  100. POKEW p%,PEEKW(p%) or 1
  101.  
  102. p%=PEEKW($1c)+$1e
  103. POKEW p%,PEEKW(p%) and $fffe
  104.  
  105. 6: Graphics
  106.  
  107. PROC exgrey:
  108.   DEFAULTWIN 1                       REM enable grey
  109.   gAT 0,40  :gGREY 1 :gLINEBY 480,0  REM grey only
  110.   gAT 0,41  :gLINEBY 480,0
  111.   gAT 0,80  :gGREY 0 :gLINEBY 480,0  REM black only
  112.   gAT 0,81  :gLINEBY 480,0
  113.   gAT 0,120 :gGREY 2 :gLINEBY 480,0  REM both planes
  114.   gAT 0,121  :gLINEBY 480,0
  115.   GET
  116.   gGREY 0                            REM black only
  117.   gCLS                               REM clear it
  118.   GET
  119. ENDP
  120.  
  121. PROC face:
  122.   gFILL 120,120,0 REM set the entire face
  123.   gMOVE 10,20 :gFILL 30,20,1 REM left eye
  124.   gMOVE 70,0 :gFILL 30,20,1 REM right eye
  125.   gMOVE -30,30 :gFILL 20,30,1 REM nose
  126.   gMOVE -20,40 :gFILL 60,20,1 REM mouth
  127.   GET
  128. ENDP
  129.  
  130. PROC wink:
  131.   gMOVE 10,20 REM move to left eye
  132.   gFILL 30,14,2 REM invert most of the eye
  133.   PAUSE 10
  134.   gFILL 30,14,2 REM invert it back again
  135.   GET
  136. ENDP
  137.  
  138. PROC brow:
  139.   gGMODE 1 REM gLINEBY will now clear pixels
  140.   gMOVE 10,8 :gLINEBY 100,0
  141.   gMOVE 0,4 :gLINEBY -100,0
  142.   gGMODE 0
  143.   GET
  144. ENDP
  145.  
  146. PROC fonts:
  147.   showfont:(4,15,"Mono 8x8")
  148.   showfont:(5,25,"Roman 8")
  149.   showfont:(6,38,"Roman 11")
  150.   showfont:(7,53,"Roman 13")
  151.   showfont:(8,71,"Roman 16")
  152.   showfont:(9,81,"Swiss 8")
  153.   showfont:(10,94,"Swiss 11")
  154.   showfont:(11,109,"Swiss 13")
  155.   showfont:(12,127,"Swiss 16")
  156.   showfont:(13,135,"Mono 6x6")
  157.   GET
  158. ENDP
  159.  
  160. PROC showfont:(font%,y%,str$)
  161.     gFONT font%
  162.     gAT 20,y% :gPRINT font%
  163.     gAT 50,y% :gPRINT str$
  164.     gAT 150,y% :gPRINT "!!!"
  165. ENDP
  166.  
  167. PROC style:
  168.   gAT 20,50 :gFONT 11
  169.   gSTYLE 12 :gPRINT "Attention!"
  170.   GET
  171. ENDP
  172.  
  173. PROC tmode:
  174.   DEFAULTWIN 1                REM enable grey
  175.   gFONT 11    :gSTYLE 0
  176.   gAT 160,0   :gFILL 160,80,0 REM Black box
  177.   gAT 220,0   :gFILL 40,80,1  REM White box
  178.   gAT 180,20  :gTMODE 0 :gPRINT "ABCDEFGHIJK"
  179.   gAT 180,35  :gTMODE 1 :gPRINT "ABCDEFGHIJK"
  180.   gAT 180,50  :gTMODE 2 :gPRINT "ABCDEFGHIJK"
  181.   gAT 180,65  :gTMODE 3 :gPRINT "ABCDEFGHIJK"
  182.   gGREY 1
  183.   gAT 160,80  :gFILL 160,80,0 REM Grey box
  184.   gAT 220,80  :gFILL 40,80,1  REM White box
  185.   gAT 180,100 :gTMODE 0 :gPRINT "ABCDEFGHIJK"
  186.   gAT 180,115 :gTMODE 1 :gPRINT "ABCDEFGHIJK"
  187.   gAT 180,130 :gTMODE 2 :gPRINT "ABCDEFGHIJK"
  188.   gAT 180,145 :gTMODE 3 :gPRINT "ABCDEFGHIJK"
  189.   GET
  190. ENDP
  191.  
  192. PROC windows:
  193.   LOCAL id%
  194.   id%=gCREATE(60,40,240,30,1,1)
  195.   gBORDER 0 :gAT 20,20 :gLINEBY 0,0
  196.   gPRINT " 20,20 (new)"
  197.   GET
  198.   gUSE 1 :gAT 20,20 :gLINEBY 0,0
  199.   gPRINT " 20,20 (default)"
  200.   GET
  201.   gUSE id%
  202.   gGREY 1        REM draw grey
  203.   gPRINT " Back"
  204.   gGREY 0
  205.   gPRINT " (with grey)"
  206.   GET
  207. ENDP
  208.  
  209. PROC gsetw1:
  210.   LOCAL a$(100),w%,h%,g$(1),factor%,info%(10)
  211.   LOCAL margx%,margy%,chrw%,chrh%,defw%,defh%
  212.   SCREENINFO info%()       REM get text window information
  213.   margx%=info%(1) :margy%=info%(2)
  214.   chrw%=info%(7) :chrh%=info%(8)
  215.   defw%=23*chrw%+2*margx%  REM new default window width
  216.   defh%=chrh%+2*margy%     REM ... and height
  217.   w%=gWIDTH :h%=gHEIGHT
  218.   gSETWIN w%/4+margx%,h%/4+margy%,defw%,defh%
  219.   SCREEN 23,1,1,1   REM text window
  220.   PRINT "Text win:"; :GET
  221.   gCREATE(w%*.1,h%*.1,w%*.8,h%*.8,1)   REM new window
  222.   gPATT -1,gWIDTH,gHEIGHT,0 REM shade it
  223.   gAT 2,h%*.7 :gTMODE 4
  224.   gPRINT "Graphics window 2"
  225.   gORDER 1,0 REM back to default+text window
  226.   EDIT a$               REM you can see this edit
  227.   gORDER 1,9 REM to background
  228.   CLS
  229.   a$=""
  230.   PRINT "Hidden:";
  231.   GIPRINT "Edit in hidden edit box"
  232.   EDIT a$               REM YOU CAN'T SEE THIS EDIT
  233.   GIPRINT ""
  234.   gORDER 1,0 :GET REM now here it is
  235.   gUSE 1 REM graphics go to default window
  236.   DO  REM move default/text window around
  237.     CLS
  238.     PRINT "U,D,L,R,Quit";
  239.     g$=UPPER$(GET$)
  240.     IF kmod=2 REM Shift key moves quickly
  241.       factor%=10
  242.     ELSE
  243.       factor%=1
  244.     ENDIF
  245.     IF g$="U"
  246.       gSETWIN gORIGINX,gORIGINY-factor%
  247.     ELSEIF g$="D"
  248.       gSETWIN gORIGINX,gORIGINY+factor%
  249.     ELSEIF g$="L"
  250.       gSETWIN gORIGINX-factor%,gORIGINY
  251.     ELSEIF g$="R"
  252.       gSETWIN gORIGINX+factor%,gORIGINY
  253.     ENDIF
  254.   UNTIL g$="Q" OR g$=CHR$(27)
  255. ENDP
  256.  
  257. 7: Friendlier interaction
  258.  
  259. PROC kget%:
  260.   LOCAL k%,h$(9),a$(5)
  261.   h$="nosciefgd" REM our hot-keys
  262.   WHILE 1
  263.     k%=GET
  264.     IF k%=$122   REM Menu key?
  265.       mINIT
  266.       mCARD "File","New",%n,"Open",%o,"Save",%s
  267.       mCARD "Edit","Copy",%c,"Insert",-%i,"Eval",%e
  268.       mCARD "Search","First",%f,"Next",%g,"Previous",%d
  269.       k%=MENU
  270.       IF k% AND (LOC(h$,CHR$(k%))<>0)     REM MENU CHECK
  271.          a$="proc"+CHR$(k%)
  272.         @(a$): REM procn:, proco:, ...
  273.       ENDIF                        REM END OF MENU CHECK
  274.     ELSEIF k% AND $200  REM hot-key pressed directly?
  275.       k%=k%-$200        REM remove Psion key code
  276.       IF LOC(h$,CHR$(k%))       REM DIRECT HOT-KEY CHECK
  277.          a$="proc"+CHR$(k%)
  278.         @(a$): REM procn:, proco:, ...
  279.       ENDIF              REM END OF DIRECT HOT-KEY CHECK
  280.     ELSE REM some other key
  281.       RETURN k%
  282.     ENDIF
  283.   ENDWH
  284. ENDP
  285.  
  286. PROC procn:
  287. ...
  288. ENDP
  289.  
  290. PROC proco:
  291. ...
  292. ENDP
  293.  
  294. IF k%<=%Z     REM if upper case hot-key
  295.   IF LOC(hu$,CHR$(k%))
  296.     a$="procu"+CHR$(k%)
  297.     @(a$) :REM procua:, procuc:, ...
  298.   ENDIF
  299. ELSE          REM else lower case hot-key
  300.   IF LOC(hl$,CHR$(k%))
  301.     a$="procl"+CHR$(k%)
  302.     @(a$) :REM procla:, procld:, ...
  303.   ENDIF
  304. ENDIF
  305.  
  306. PROC dcheck:
  307.   LOCAL c%
  308.   c%=2         REM default to "Internal"
  309.   dINIT "Disk Check"
  310.   dCHOICE c%,"Disk:","A,Internal,B"
  311.   IF DIALOG    REM returns 0 if cancelled
  312.     ... REM disk-check code
  313.   ENDIF
  314. ENDP
  315.  
  316. PROC delivery:
  317.   LOCAL d&,t&,num&,wt
  318.   d&=DAYS(DAY,MONTH,YEAR)
  319.   DO
  320.     t&=secs&:
  321.   UNTIL t&=secs&:
  322.   num&=1 :wt=10
  323.   dINIT "Delivery"
  324.   dLONG num&,"Boxes",1,1000
  325.   dFLOAT wt,"Weight (kg)",0,10000
  326.   dDATE d&,"Date",d&,DAYS(31,12,1999)
  327.   dTIME t&,"Time",0,0,DATETOSECS(1970,1,1,23,59,59)
  328.   IF DIALOG    REM returns 0 if cancelled
  329.     ...  REM rest of code
  330.   ENDIF
  331. ENDP
  332.  
  333. PROC secs&:
  334.    RETURN HOUR*INT(3600)+MINUTE*60
  335. ENDP
  336.  
  337. PROC daytodat:(days&)
  338.   LOCAL dyscent&(2),dateent%(4)
  339.   LOCAL flags%,ax%,bx%,cx%,dx%,si%,di%
  340.   dyscent&(1)=days&
  341.   si%=ADDR(dyscent&()) :di%=ADDR(dateent%())
  342.   ax%=$0600 REM TimDaySecondsToDate fn.
  343.   flags%=OS($89,ADDR(ax%)) REM TimManager int.
  344.   IF flags% AND 1
  345.     RAISE (ax% OR $ff00)
  346.   ELSE
  347.     year%=PEEKB(di%)+1900 :month%=PEEKB(UADD(di%,1))+1
  348.     day%=PEEKB(UADD(di%,2))