#! /usr/local/bin/apl --script
⍝ ********************************************************************
⍝   $Id: $
⍝ $desc: prompt system $
⍝ ********************************************************************

)copy 1 util
)copy 1 lex

∇b←prompt∆ec∆date date;bv
  ⍝ Edit check for a prompt object whose target is a date
  →(0=b←0<+/~bv←'/'≠date)/ed
  'b←0' ⎕ea 'b←3=⍴⍎bv\bv/date'
ed:
  →b/0
  ⍞←date,' is not a valid date. '
∇

∇new←level prompt∆loop prompt;test;ans;ok;nnext;pz
  ⍝ Subroutine to prompt for user input.
  →(2=⎕nc 'level')/pt
  level←0
pt:
  level←level+1
  new←prompt
st:
  pz←new lex∆lookup 'prompt'
  ⍞←pz
  ans←⍞
  ⍝test←(∧\ans≠' ')/ans
  →(util∆numberp test←util∆∆keys ans)/kw
  ⍎'ok←',(new lex∆lookup 'edit_check'),' ans'
  →(~ok)/st
  new←new lex∆assign 'ans' ans
  →(~new lex∆haskey 'next')/no_next
  nnext←level prompt∆loop new lex∆lookup 'next'
  new←new lex∆assign 'next' nnext
  new←new lex∆assign 'keyword' test←nnext lex∆lookup 'keyword'
  →(prompt∆∆back=test)/st
  →((level=1)∧prompt∆∆quit≠test)/st
kw:
  new←new lex∆assign 'keyword' test
  →0
no_next:
  →0
∇

∇b←prompt∆ec∆nul ans
  ⍝ Edit check for a prompt object that need not be checked
  b←1
∇

∇b←prompt∆ec∆fns ans
  ⍝ edit check for a prompt object whose target is a function.
  →(b←3=⎕nc ans)/0
  ⍞←ans,' is not a function in this workspace. '
∇

∇b←prompt∆ec∆var ans
  ⍝ Edit check for a prompt object whose target is a variable
  →(b←2=⎕nc ans)/0
  ⍞←ans,' is not a variable in this workspace. '
∇

∇b←prompt∆∆ec∆next ans
  ⍝ Edit check for prompt object prompt∆dialog∆n, the next prompt object
  →(b←0=⍴ans)/0			⍝ No answer is good enough
  →(~b←2=⎕nc ans)/er1
  →(~⍎'b←lex∆is ',ans)/er2
  →(~⍎'b←',ans,' lex∆haskey ''prompt''')/er2
  →(~⍎'b←',ans,' lex∆haskey ''edit_check''')/er2
  ⍎'b←',ans,' lex∆haskey ''ans'''
  →0
er1:⍞←ans,' does not exist in the workspace. '
  →0
er2:⍞←ans,' is not a prompt object. '
  →0
  
∇

∇po←prompt∆object;resp;pt;ec;nxt
  ⍝ Function to create a prompt object
  po←lex∆init
  resp←prompt∆loop prompt∆∆dialog∆p
  →(prompt∆∆quit = resp lex∆lookup 'keyword')/0
  pt←resp lex∆lookup 'ans'
  ⍎(':'=¯1↑pt)/'pt←pt,'' '''
  ⍎(~∧/': '=¯2↑pt)/'pt←pt,'': '''
  po←po lex∆assign 'prompt' pt
  resp←resp lex∆lookup 'next'
  ec←resp lex∆lookup 'ans'
  po←po lex∆assign 'edit_check' ec
  resp←resp lex∆lookup 'next'
  nxt←resp lex∆lookup 'ans'
  ⍎(0≠⍴nxt)/'po←po lex∆assign (⊂''next''),⊂',nxt
  po←po lex∆assign 'ans' ''
  po←po lex∆assign 'keyword' prompt∆∆nul
∇

  ⍝ Keyword constants

  prompt∆∆keyword←4 4⍴'quittop doneback'

  prompt∆∆nul←¯1

  prompt∆∆quit←0

  prompt∆∆top←1

  prompt∆∆done←2

  prompt∆∆back←3

  inv∆date_prompt←(lex∆init)lex∆assign 'prompt' 'Enter statement date: '
  inv∆date_prompt←inv∆date_prompt lex∆assign 'edit_check' 'prompt∆ec∆date'
  inv∆date_prompt←inv∆date_prompt lex∆assign 'ans' ''
  inv∆date_prompt←inv∆date_prompt lex∆assign 'keyword' prompt∆∆nul

  inv∆type_prompt←(lex∆init)lex∆assign 'prompt' 'Enter BS for balance sheet or IN for income statement: '
  inv∆type_prompt←inv∆type_prompt lex∆assign 'edit_check' 'inv∆edit_check∆type'
  inv∆type_prompt←inv∆type_prompt lex∆assign 'ans' ''
  inv∆type_prompt←inv∆type_prompt lex∆assign 'keyword' prompt∆∆nul
  inv∆type_prompt←inv∆type_prompt lex∆assign 'next' inv∆date_prompt

  inv∆id_prompt←(lex∆init) lex∆assign 'prompt' 'Enter stock ticker: '
  inv∆id_prompt←inv∆id_prompt lex∆assign 'edit_check' 'inv∆edit_check∆ticker'
  inv∆id_prompt←inv∆id_prompt lex∆assign 'ans' ''
  inv∆id_prompt←inv∆id_prompt lex∆assign 'keyword' prompt∆∆nul
  inv∆id_prompt←inv∆id_prompt  lex∆assign 'next' inv∆type_prompt

  prompt∆∆dialog∆n←(lex∆init) lex∆assign 'prompt' 'Enter name of prompt object for next imput prompt: '
  prompt∆∆dialog∆n←prompt∆∆dialog∆n lex∆assign 'edit_check' 'prompt∆∆ec∆next'
  prompt∆∆dialog∆n←prompt∆∆dialog∆n lex∆assign 'ans' ''
  prompt∆∆dialog∆n←prompt∆∆dialog∆n lex∆assign 'keyword' prompt∆∆nul

  prompt∆∆dialog∆e←(lex∆init)lex∆assign 'prompt' 'Enter function for edit check: '
  prompt∆∆dialog∆e←prompt∆∆dialog∆e lex∆assign 'edit_check' 'prompt∆ec∆fns'
  prompt∆∆dialog∆e←prompt∆∆dialog∆e lex∆assign 'ans' ''
  prompt∆∆dialog∆e←prompt∆∆dialog∆e lex∆assign 'next' prompt∆∆dialog∆n
  prompt∆∆dialog∆e←prompt∆∆dialog∆e lex∆assign 'keyword' prompt∆∆nul

  prompt∆∆dialog∆p←(lex∆init)lex∆assign 'prompt' 'Enter text of prompt with a colon and a space: '
  prompt∆∆dialog∆p←prompt∆∆dialog∆p lex∆assign 'edit_check' 'prompt∆ec∆nul'
  prompt∆∆dialog∆p←prompt∆∆dialog∆p lex∆assign 'ans' ''
  prompt∆∆dialog∆p←prompt∆∆dialog∆p lex∆assign 'next' prompt∆∆dialog∆e
  prompt∆∆dialog∆p←prompt∆∆dialog∆p lex∆assign 'keyword' prompt∆∆nul

  stocks←30 2⍴0 ⍝ prolog ≡1
  (,stocks)[⍳21]←00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  (,stocks)[21+⍳20]←00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  (,stocks)[41+⍳19]←00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  ((⎕IO+(⊂0 0))⊃stocks)←'MMM       '
  ((⎕IO+(⊂0 1))⊃stocks)←'3M '
  ((⎕IO+(⊂1 0))⊃stocks)←'AXP       '
  ((⎕IO+(⊂1 1))⊃stocks)←'American Express '
  ((⎕IO+(⊂2 0))⊃stocks)←'AAPL      '
  ((⎕IO+(⊂2 1))⊃stocks)←'Apple '
  ((⎕IO+(⊂3 0))⊃stocks)←'BA        '
  ((⎕IO+(⊂3 1))⊃stocks)←'Boeing '
  ((⎕IO+(⊂4 0))⊃stocks)←'CAT       '
  ((⎕IO+(⊂4 1))⊃stocks)←'Caterpillar '
  ((⎕IO+(⊂5 0))⊃stocks)←'CVX       '
  ((⎕IO+(⊂5 1))⊃stocks)←'Chevron '
  ((⎕IO+(⊂6 0))⊃stocks)←'CSCO      '
  ((⎕IO+(⊂6 1))⊃stocks)←'Cisco '
  ((⎕IO+(⊂7 0))⊃stocks)←'KO        '
  ((⎕IO+(⊂7 1))⊃stocks)←'Coca-Cola '
  ((⎕IO+(⊂8 0))⊃stocks)←'DIS       '
  ((⎕IO+(⊂8 1))⊃stocks)←'Disney '
  ((⎕IO+(⊂9 0))⊃stocks)←'DD        '
  ((⎕IO+(⊂9 1))⊃stocks)←'E I du Pont de Nemours and Co '
  ((⎕IO+(⊂10 0))⊃stocks)←'XOM       '
  ((⎕IO+(⊂10 1))⊃stocks)←'Exxon Mobil '
  ((⎕IO+(⊂11 0))⊃stocks)←'GE        '
  ((⎕IO+(⊂11 1))⊃stocks)←'General Electric '
  ((⎕IO+(⊂12 0))⊃stocks)←'GS        '
  ((⎕IO+(⊂12 1))⊃stocks)←'Goldman Sachs '
  ((⎕IO+(⊂13 0))⊃stocks)←'HD        '
  ((⎕IO+(⊂13 1))⊃stocks)←'Home Depot '
  ((⎕IO+(⊂14 0))⊃stocks)←'IBM       '
  ((⎕IO+(⊂14 1))⊃stocks)←'IBM '
  ((⎕IO+(⊂15 0))⊃stocks)←'INTC      '
  ((⎕IO+(⊂15 1))⊃stocks)←'Intel '
  ((⎕IO+(⊂16 0))⊃stocks)←'JNJ       '
  ((⎕IO+(⊂16 1))⊃stocks)←'Johnson & Johnson '
  ((⎕IO+(⊂17 0))⊃stocks)←'JPM       '
  ((⎕IO+(⊂17 1))⊃stocks)←'JPMorgan Chase '
  ((⎕IO+(⊂18 0))⊃stocks)←'MCD       '
  ((⎕IO+(⊂18 1))⊃stocks)←'McDonald''s '
  ((⎕IO+(⊂19 0))⊃stocks)←'MRK       '
  ((⎕IO+(⊂19 1))⊃stocks)←'Merck '
  ((⎕IO+(⊂20 0))⊃stocks)←'MSFT      '
  ((⎕IO+(⊂20 1))⊃stocks)←'Microsoft '
  ((⎕IO+(⊂21 0))⊃stocks)←'NKE       '
  ((⎕IO+(⊂21 1))⊃stocks)←'Nike '
  ((⎕IO+(⊂22 0))⊃stocks)←'PFE       '
  ((⎕IO+(⊂22 1))⊃stocks)←'Pfizer '
  ((⎕IO+(⊂23 0))⊃stocks)←'PG        '
  ((⎕IO+(⊂23 1))⊃stocks)←'Procter & Gamble '
  ((⎕IO+(⊂24 0))⊃stocks)←'TRV       '
  ((⎕IO+(⊂24 1))⊃stocks)←'Travelers Companies Inc '
  ((⎕IO+(⊂25 0))⊃stocks)←'UTX       '
  ((⎕IO+(⊂25 1))⊃stocks)←'United Technologies '
  ((⎕IO+(⊂26 0))⊃stocks)←'UNH       '
  ((⎕IO+(⊂26 1))⊃stocks)←'UnitedHealth '
  ((⎕IO+(⊂27 0))⊃stocks)←'VZ        '
  ((⎕IO+(⊂27 1))⊃stocks)←'Verizon '
  ((⎕IO+(⊂28 0))⊃stocks)←'V         '
  ((⎕IO+(⊂28 1))⊃stocks)←'Visa '
  ((⎕IO+(⊂29 0))⊃stocks)←'WMT       '
  ((⎕IO+(⊂29 1))⊃stocks)←'Wal-Mart '

  ⎕CT←1E¯13

  ⎕FC←(,⎕UCS 46 44 8902 48 95 175)

  ⎕IO←1

  ⎕L←0

  ⎕LX←' ' ⍝ prototype...
  ⎕LX←0⍴⎕LX

  ⎕PP←10

  ⎕PR←' '

  ⎕PS←0

  ⎕PW←80

  ⎕R←0

  ⎕RL←16807

  ⎕TZ←-5

  ⎕X←0