home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol227 / geneolgy.lbr / EXPLORE.CMD next >
Encoding:
Text File  |  1986-02-10  |  5.9 KB  |  311 lines
  1. *** EXPLORE.CMD - ROOT PROGRAM FOR THE EXPLORATION ON THE GENEOLOGICAL DATA BASE.
  2. ***  version 1.0
  3.  
  4. *** change the following line to suit your installation ***
  5. SET DEFAULT TO B:
  6.  
  7. *** GETTING STARTED ***
  8. RELEASE ALL
  9. USE PERSONS INDEX REF,FATHER,MOTHER,NAME
  10. SET TALK OFF
  11. SET BELL OFF
  12. erase
  13. store '0000' to curper
  14. store '1111' to m1
  15. store t to cont
  16. store "N" to command
  17. store f to didhelp
  18. @ 12,0 say "type (H)elp to see what the commands listed below"
  19. @ 14,11 say "allow you do."
  20. @ 4,10 say "G E N E A L O G Y "
  21. @ 6,0 SAY "copyright 1984 by S. Washburn"
  22. @ 7,0 say "for public domain use only"
  23.  
  24. *** main loop ***
  25.  
  26. do while cont
  27. set intensity on
  28. If .not. didhelp
  29.    *** see what he wants to do. ***
  30.    @ 22,0
  31.    @ 22,0 say 'ENTER A COMMAND ->NRGBFMSCAELQ 8426<- H = Help ?' GET COMMAND PICTURE '!'
  32.    read
  33. endif
  34. store F to didhelp
  35.  
  36. do case
  37.  
  38. Case command ="A"
  39.     set carry on
  40.     append
  41.     store ref:no to m1
  42.     store ref:no to curper
  43.     if val(curper)
  44.         do explore1
  45.     endif
  46.     set carry off       
  47.  
  48. case command = "R"
  49.    set intensity on
  50.    if val(curper)<>0
  51.       store curper to M1
  52.    endif
  53.    @ 22,0
  54.    @ 22,0 say "enter a person's reference number?" get M1 picture "9999"
  55.    read
  56.    store M1 to curper
  57.    if val(m1)<>0
  58.       do explore1
  59.    endif
  60.  
  61. case command ="N"
  62.    DO NS
  63.  
  64. case command ="C"
  65.    if val(m7)>0 .and. childcount>0
  66.     store M7 to curper
  67.     store M7 to M1
  68.     do explore1
  69.    endif
  70.  
  71. case command ="Q"
  72.    store f to cont
  73.  
  74. case command ="G"
  75.    if val(curper)<>0
  76.       store curper to m1
  77.       do explore1
  78.    endif
  79.  
  80. case command ="E"
  81.     find &curper
  82.     if #
  83.         store str(#,4) to line
  84.         edit &line
  85.         store ref:no to m1
  86.         store ref:no to curper
  87.     endif
  88.     if val(curper)
  89.         do explore1
  90.     endif    
  91.  
  92. case command ="F"
  93.    if val(m2)
  94.       store m2 to curper
  95.       store m2 to M1
  96.       do explore1
  97.    endif
  98.  
  99. case command = "L"
  100.     store " "to command
  101.     set format to list
  102.     read
  103.     set format to screen
  104.     if command $ "Nn"
  105.         erase
  106.         set print on
  107.         set index to name
  108.         list last:name, first:name,"B:",$(str(birth:date,8),1,4),"ref=",ref:no off
  109.         set print off
  110.     endif
  111.     if command $ "Rr"
  112.         erase
  113.         set print on
  114.         set index to ref
  115.         list ref:no, trim(last:name), trim(first:name),"B:",$(str(birth:date,8),1,4) off
  116.         set print off
  117.     endif
  118.     set index to ref,father,mother,name
  119.     if val(curper)
  120.         do explore1
  121.     endif    
  122.  
  123. case command ="M"
  124.    if val(m3)
  125.       store m3 to curper
  126.       store M3 to m1
  127.       do explore1
  128.    endif
  129.  
  130. case command ="S"
  131.    if val(m4)
  132.       store m4 to curper
  133.       store m4 to M1
  134.       do explore1
  135.    endif
  136.  
  137. case command ="B"
  138.    if val(curper)
  139.     do story       
  140.    endif
  141.  
  142. case command $ "H?,"
  143.    set intensity off
  144.    do while command $ "Hh?,"
  145.        store " " to command
  146.        set format to helpexp
  147.        read
  148.     if command $ "?," 
  149.         store " "to command
  150.         set format to helpexp2
  151.         read
  152.         if command $ "?,"
  153.             store " " to command
  154.             set format to helpexp3
  155.             read
  156.             if command $ "?,"
  157.                 store " " to command
  158.                 set format to helpexp4
  159.                 read
  160.             endif
  161.         endif
  162.     endif
  163.    enddo    
  164.    set format to screen
  165.    if val(curper)
  166.        do explore1
  167.    endif
  168.    if command <> " "
  169.     store T to didhelp
  170.    endif
  171.    store !(command) to command
  172.  
  173. case command = "I"
  174.     do newindex
  175.     if val(curper)
  176.         do explore1
  177.     endif
  178.  
  179. case  command $ "8426!'{]"
  180.    store row to nrow
  181.    store col to ncol
  182.  
  183. *** calculate new row and collumn ***
  184.  
  185.    if command $ "8!"
  186.      store row-1 to nrow
  187.    else
  188.       if command $ "2{"
  189.          store row+1 to nrow
  190.       else
  191.          if command $ "4'"
  192.             store col-1 to ncol
  193.          else
  194.             if command $ "6]"
  195.                store col+1 to ncol
  196.             endif
  197.          endif
  198.       endif
  199.     endif
  200.  
  201. *** continue only if new position is on screen ***
  202.  
  203. if ncol>0 .and. Nrow>0 .and. ncol<5 .and. nrow<7
  204. if .not. (nrow=1 .and. Ncol>2)
  205.  
  206. *** figure out the memory variable in the new cell ***
  207.  
  208.       if nrow=1
  209.          if ncol=1
  210.             store M2 to nref
  211.          else
  212.             store m3 to nref
  213.          endif
  214.       else
  215.       if nrow=2
  216.             if ncol=1
  217.               store M1 to nref
  218.             else
  219.                if ncol=2
  220.                   store m4 to nref
  221.                else
  222.                   if ncol=3
  223.                      store m5 to nref
  224.                   else
  225.                      if ncol=4
  226.                         store m6 to nref
  227.                      endif
  228.                   endif
  229.                endif
  230.             endif
  231.         else
  232.         if nrow>2
  233. *set echo on
  234. *set step on
  235.            store (ncol-1)*4+nrow-2 to child1
  236.            if child1>childcount
  237.               store "0" to nref
  238.            else
  239.               store str(child1+6,2) to child
  240.               if val(child)<10
  241.                  store $(child,2,1) to child
  242.               endif
  243.               store m&child to nref
  244.            endif
  245.          endif
  246.        endif
  247.      endif
  248.         **** DEBUG LINES    
  249.         *set echo off
  250.         *set step off
  251.  
  252. *** continue only if cell is occupied ***
  253.  
  254. if val(nref)<>0
  255.  
  256. *** display marker at new position ***
  257.  
  258.    @ &prow, &pcol say " "
  259.    store str((ncol-1)*26,2) to pcol
  260.  
  261.       if nrow=1
  262.          store "2" to prow
  263.       else
  264.          if nrow=2
  265.             store "6" to prow
  266.          else
  267.             if nrow>2
  268.                store str(10+(nrow-3)*3,2) to prow
  269.             endif
  270.          endif
  271.        endif
  272.  
  273.    set intensity off
  274.    @ &prow,&pcol say '*'
  275.  
  276.    store nrow to row
  277.    store ncol to col
  278.    store nref to curper
  279.  
  280. endif
  281. endif
  282. endif
  283.  
  284.     ***** DEBUG LINES
  285.     ** @ 23,0 say 'nref='+nref+' curper='+curper+' chcnt=';
  286.     ** +str(childcount,2)+' '+str(row,2)+' '+str(col,2)
  287.  
  288. case command="Z"
  289.     set format to ghost
  290.     read
  291.     set format to screen
  292.     if val(curper)
  293.         do explore1
  294.     endif
  295.  
  296. otherwise
  297.    @ 22,0
  298.    @ 22,0 say command+" command unknown. Type any key"
  299.    wait
  300.  
  301. endcase
  302.  
  303. if .not. didhelp
  304.     store " " to command
  305. endif
  306.  
  307. enddo
  308.  
  309. return
  310.  
  311.