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