path: root/ipl/progs/literat.icn

############################################################################
#
#	File:     literat.icn
#
#	Subject:  Program to manage literature information
#
#	Author:   Matthias Heesch
#
#	Date:     March 26, 2002
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#    Database system to manage information concerning literature.
#
############################################################################
#
#		   Written by: Dr. Matthias Heesch
#	       Department of Protestant Theology (FB 02)
#		    Johannes Gutenberg University
#	     Saarstrasse 21 / D-W-6500 Mainz 1 / Germany
#
############################################################################
#
#  Written and tested under: DR/MS-DOS, using ansi.sys
#
############################################################################
#
#  See the comment lines concerning the single user defined
#  functions if you want to use them separately. Note that all screen
#  access assumes ansi.sys to be installed.
#
#  Since arguments to the seek() function may be long integers,
#  long-integer support is required.
#
#  The program uses standard files literat.fil, literat2.fil and
#  adress.fil to store its data on the disk. It has a predefined
#  structure of the items and predefined field labels to make it easy
#  to use and to cut down the source code length.for users having some
#  knowledge of the Icon language it shouldn't be difficult to
#  change the program. In this case the item length (now 846 byte)
#  the option lists in menue() and the field label list have to be
#  modified. The main changes then will concern user defined
#  function edit_item() where the number of fields within an item
#  is decided by *labels. In function in_itemm() the number of dummy
#  field separators has to be equal to the amount of fields desired.
#  (items := list(200,"##" if two fields are desired). Within the
#  other functions only the amount of bytes for a whole item within
#  reads() and seek() operation has to be changed accordingly. Note
#  that "literat"'s editor in its present version isn't able to scroll.
#								
#  See the description (comment lines) of user defined function
#  line() for details of the editing facilities. 		
#
#  The menue accepts input by <arrow up/dn> and the lower case short
#  hand key of every option. The selected option has to be activated
#  by <ret>.							
#
#  iNPUT: function to update an existing file literat.dat. When moving
#  the cursor out of the actual item, the last or following item will
#  be displayed and is available for the editing process. Input treats
#  literat.dat as a sequential file. Only the items to be added to the
#  existing file are in the computer's memory. This fastens the option
#  to switch between the (new) items. Otherwise it would have been
#  necessary to load the whole literat.dat into the RAM or to load
#  every new item from the disk. The first would consume too much
#  memory with the result of potential loss of new items, the second
#  would cost much time. In one session "literat" can accept no more
#  than 200 new items.
#
#  tURN_OVER_ITEMS: literat.dat can be viewed and edited item by item
#  moving the cursor out of the actual item causes the next/last item
#  to be displayed. The edited items are written to file literat2.fil
#
#  aDRESS file: type words to be indicated. If they are found, the
#  item numbers of their occurrence will be recorded in file adress.fil.
#  Moving the cursor out of the editor causes the indicating	
#  process to start. New items to adress.fil are simply added to the
#  file. Therefore changes of existing material in adress.fil have to
#  be made by creating a new adress.fil. 			
#
#  qUERY: searches item using the information in adress.fil. You are
#  prompted to type a word and if it's found in adress.fil the
#  programm will use the item numbers to compute arguments to the
#  seek()-function and then read the item. After viewing and if	
#  desired editing the item it will be written to file literat2.fil.
#
#  dEL: prompts for an item number and removes the corresponding item.
#  the file then is written to literat2.fil, literat.fil remains
#  as it was.
#
#  AlPHA: alphabetical sorting, sorted file written to literat2.fil.
#
#  eND: return to the operating system.				
#
############################################################################
#
#  Important message to the user: everybody who will find and remove
#  a bug or add any improvement to the program is kindly encouraged
#  to send a copy to the above address.				
#
############################################################################
#
#  Note:  Clerical edits were made to this file by the Icon Project.
#         It's possible they introduced errors.
#
############################################################################
#
#  Requires:  large-integer arithmetic, ANSI terminal support
#
############################################################################

############################################################################
#								     #
#	       linfield:  line and field editing package	     #
#								     #
############################################################################
#
#
############################################################################
#								     #
# set of user defined functions essential to the line editor line()  #
#								     #
############################################################################
#
# newkey(): redirects keyboard to make some of the editing functions
# accessable also by arrow/ctrl-arrow-keys. needs ansi.sys.
# although newkey() isn't called by line() directly, a program
# which uses line() should contain a call to newkey(), because
# otherwise line()'S function won't be available for cursor keys.

	procedure newkey()

   local code, n_keys
		n_keys := list(9)
# arrow left (cursor left)
		n_keys[1] := char(27) || "[0;77;1p"
# arrow right (cursor right)
		n_keys[2] := char(27) || "[0;75;2p"
# arrow up (quit, decreasing line_number)
		n_keys[3] := char(27) || "[0;72;14p"
# arrow down (quit, increasing line_number)
		n_keys[4] := char(27) || "[0;80;21p"
# ctrl/left
		n_keys[5] := char(27) || "[0;116;8p"
# ctrl/right
		n_keys[6] := char(27) || "[0;115;9p"
# home
		n_keys[7] := char(27) || "[0;71;4p"
# end
		n_keys[8] := char(27) || "[0;79;5p"
# deL
		n_keys[9] := char(27) || "[0;83;6p"
#
# activate codes
	while code := get(n_keys) do {
		writes(code)
	}
end
#
#
# function to set cursor position
	procedure locate(row,col)

   local cursor

		cursor := char(27) || "[" || row || ";" || col || "H"
		writes(cursor)
end
#
# last(byte,string): detects the last occurrence of byte in
# string and returns its position
	procedure last(byte,string)

   local a, r_string, rpos

		r_string := reverse(string)
		rpos := find(byte,r_string)
		a := (*string - rpos)
		return a
end
#
# remword(string,acol): removes word at acol from string
	procedure remword(string,acol)

   local blank, string_a, string_b

# if acol points to end of string, don`t do anything
		if acol + 1 > *string then return string
# if acol points to a blank just remove the blank
		if string[acol + 1] == " " then {
		    string ? {
			string_a := tab(acol + 1)
			move(1)
			string_b := tab(0)
			string := string_a || string_b
			return string
		    }
		}
# else delete actual word
		if acol = 0 then acol := 1
# crack string into two parts
		string ? {
		    string_a := tab(acol + 1)
		    string_b := tab(0)
		}
# check string_a for the last blank if any
		if find(" ",string_a) then {
			blank := last(" ",string_a)
			string_a := string_a[1:blank + 1]
		}
		else string_a := ""
# check string_b for the first blank if any
		if blank := find(" ",string_b) then {
			string_b := string_b[blank:*string_b + 1]
		}
		else string_b := ""
# build string out of string_a ending at its last and string_b
# beginning at its first blank.
		string := string_a || string_b
		if string[1] == " " then string[1] := ""
		return string
end
#
# stat_line: function to display a status line with the actual row
# and column
	procedure stat_line(column)
	    locate(24,1)
	    writes("LINE: ",lin_nm," COL: ",column,"  ","TIME: ",&clock,"    ")
end
#
# global variable line_number to indicate the increase or decrease
# of global variable lin_nm
	global line_number
#
# global variable lin_nm to increase or decrease actual line
# in the field
	global lin_nm
#
# global variable field_flag: direction flag to increase or
# decrease field number
	global field_flag
#
# global variable item_flag: direction flag to increase or
# decrease item number
	global item_flag
#
############################################################################
#								    #
#			   line editor line()			    #
#								    #
############################################################################
#
# editing commands for the line editor:
#		ctrl/A: byte forward (arrow right)
#		ctrl/B: byte back (arrow left)
#		ctrl/D: beginning of line (home)
#		ctrl/E: end of line (end)
#		ctrl/F: del byte (del)
#		ctrl/G: del word
#		ctrl/H: word forward (ctrl/right)
#		ctrl/I: word back (ctrl/ left)
#		ctrl/L: perform block operation
#		       1. press ctrl/L
#		       2. enter relative adress (followed by <ret>) for
#			   block end. It must be an (numerical) offset
#			   pointing right to the actual cursor.
#		       3.  enter "r" (no <ret>!) for remove or "b"
#			   to move block to the beginning of field
#			   or "e" to transfer it to the end.
#			Annotation: "impossible" adresses (beyond string
#			length or negative) will be ignored.
#		alt/A : wrap line (+ 1)
#		esc   : del line
#		ctrl/K: restore line
#		ctrl/n: quit line (- 1) (arrow up)
#		ctrl/U: quit line (+ 1) (arrow down)
#		ret   : quit line (+ 1)
############################################################################
#
# Function to edit a line. The function needs the following
# arguments
#		row    : (row of the line to be edited)
#		bnumber: (maximum size of the string to be
#			 edited, further input will be
#			 ignored.)
#		status:  display actual line_number and col2 if
#			 status == 1 else not
#		comment: (comment or input prompt)
#		field  : (contains the string to be edited.)
#
# The function returns a list with the first element containing
# The main part of FIELD and the second element containing
# the wrapped part if any.
#
	procedure line(row,bnumber,status,comment,field)

   local beg, blank, blanks, block, byte, byte_input, col, col2, dec_byte
   local dec_bytes, e1, e2, editing, fa, fb, field2, field_1, field_2
   local field_a, field_b, fieldl, highl, lg, mark, n_blank, nb, normal
   local quit, r_field, rest

# Define csets containing the keys for
#	input
#	editing functions
#	quit / wraP
#
# Characters permitted in the edited field
    n_blank := &ucase ++ &lcase ++ &digits ++ '�������?.,;!'
    byte_input := n_blank ++ ' '
# Characters for the editing functions
    e1 := set([char(1),char(2),char(4),char(5),char(6),char(7),char(8)])
    e2 := set([char(27),char(11)])
    editing := e1 ++ e2
# Characters to end editing
    quit := set([char(13),char(30),char(14),char(21)])
#
# List to return result
    fieldl := list()
# Initialize field_a/b for a concatenation, if scanning field
# fails
   field_a := ""
   field_b := ""
# Initialize r_field (variable to store completely deleted field
# to keep it recoverable)
   r_field := ""
# Codes to highlight screen output and to return to normal
# screen outpuT
   highl := char(27) || "[7m"
   normal := char(27) || "[0m"
#
# Remove single initial blank if any
	    if field[1] == " " then {
		field := field[2:(*field+1)]
	    }
#
# Display field when beginning the editing process, place
# cursor behind the end of field
		locate(row,1)
		writes(comment,field,repl(" ",(bnumber-*field)))
# If status is set to 1 display line_number and col2 after the
# initial printing of line
		if status == 1 then stat_line(*field+1)
# col: absolute cursor position (comment and field)
# col2: relative position in field
		col := (*comment + *field) + 1
		col2 := *field + 1
		locate(row,col)
#
# Editing loop: continue until end character appears
		while byte := getch() & not member(quit,byte) do {
		    if find(byte,byte_input) & *field <= bnumber - 2 then {
# If byte is a normal character (if member(byte_input,byte)) insert
# it into field at cursor position.
#
			    field ? {
				field_a := tab(col2)
				field_b := tab(0)
			    }
			    field := field_a || byte || field_b
			    locate(row,1)
			    writes(comment,field)
			    col +:= 1
			    col2 +:= 1
			    if status == 1 then stat_line(col2)
			    locate(row,col)
		    }
# else perform editing operation
		    else  {
			    case byte of {
# backspace (ctrl/B)
				char(2) : if col2 > 1 then {
				    col -:= 1
				    col2 -:= 1
				    if status == 1 then stat_line(col2)
				    locate(row,col)
				}
# byte forward (ctrl/A)
				char(1) : if col2 <= *field then {
				    col +:= 1
				    col2 +:= 1
				    if status == 1 then stat_line(col2)
				    locate(row,col)
				}
# goto beginning of line (ctrl/D)
				char(4) : {
				    col2 := 1
				    col := *comment + col2
				    if status == 1 then stat_line(col2)
				    locate(row,col)
				}
# goto end of line  (ctrl/E)
				char(5) : {
				    col2 := (*field + 1)
				    col := *comment + col2
				    if status == 1 then stat_line(col2)
				    locate(row,col)
				}
# delete byte at cursor position (ctrl/F)
				char(6) : {
				    if col2 <= *field then {
					field ? {
					    beg := tab(col2)
					    rest := tab(0)

					}
				     rest[1] := ""
				     field := beg || rest
				     locate(row,1)
				     writes(comment,field," ")
				     locate(row,col)
				     }
				}
#
# delete the actual word (ctrl/G)
			   char(7) : {
				field2 := remword(field,col2 - 1)
				blanks := *field - *field2
				field := field2
				col2 := col2 - blanks
				if col2 <= 0 then col2 := 1
				col := *comment + col2
				locate(row,1)
				writes(comment,field,repl(" ",blanks))
				if status == 1 then stat_line(col2)
				locate(row,col)
			   }

# move to the beginning of the following word (ctrl/H)
				char(8) : {
				    if find(" ",field[col2:*field]) then {
					string := field[col2:*field]
					blank := find(" ",string)
					col2 := col2 + blank
					col := *comment + col2
					if status == 1 then stat_line(col2)
					locate(row,col)
				    }
				}
#
# move to the beginning of the recent word (ctrl/I)
				char(9) : {
# jump over the blank preceding the actual word
				  if col2 = 1 then locate(row,col)
				  else {
				    if find(" ",field[1:(col2 - 2)]) then {
					string := field[1:(col2 - 2)]
					col2 := (last(" ",string) + 2)
				     }
				     else {
					col2 := 1
				     }
				   col := *comment + col2
				   if status == 1 then stat_line(col2)
				   locate(row,col)
				  }
				}
#
# Delete complete line, deleted line is assigned to r_field
# to be recoverable
				char(27) : {
					lg := *field
					r_field := field
					field := ""
					col2 := 1
					col := *comment + col2
					locate(row,1)
					writes(comment,repl(" ",lg))
					if status == 1 then stat_line(col2)
					locate(row,col)
				}
# Restore deleted line (overwrite new actual line, assigning it
# to r_field)
			      char(11) : {
				  if *r_field >= 1 then {
				      field :=: r_field
				      col2 := *field + 1
				      col := *comment + col2
				      locate(row,1)
				      blanks := bnumber - *field
				      writes(comment,field,repl(" ",blanks))
				      if status == 1 then stat_line(col2)
				      locate(row,col)
				  }
			      }

# Perform block operation
			      char(12) : {
				  mark := ""
				  dec_bytes := ""
				  while nb := getch() & nb ~== char(13) do {
					mark ||:= nb
				  }
				  if mark < 1 then mark := 1
# Place cursor to field's beginning if it points to its end
				  if col2 >= *field then col2 := 1
				  field ? {
					fa := tab(col2)
					block := move(mark)
					fb := tab(0)
				  }
				  locate(row,1)
				  writes(comment,fa,highl,block,normal,fb)
				  dec_byte := getch()
				  if dec_byte == ("r" | "R") then {
				      field := fa || fb
				      locate(row,1)
				      writes(comment,field,repl(" ",*block + 1))
				      col2 := col2 - *block
				      if col2 < 1 then col2 := 1
				      col := *comment + col2
				      if status == 1 then stat_line(col2)
				      locate(row,col)
				  }
				  else {
				       if dec_byte == ("b" | "B") then {
					   field := block || fa || fb
				       }
				       if dec_byte == ("e" | "E") then {
					   field := fa || fb || block
					   locate(row,1)
					   }
					locate(row,1)
					writes(comment,field)
					locate(row,col)
				  }
			      }

# right brace closing case control structure
		     }
# right brace closing else structure (editing keys)
		}
# right brace closing while-do loop
	   }
#
# if while-do loop stops it must be because of a key in quit.
# Therefore perform final operation and return.
#
# wrap: divide field at the last possible blank, assign the
# first part to the first element of list result, the second
# part to the second element.
	  if byte == char(30) & find(" ",field) then {
	      blank := last(" ",field)
	      field_1 := field[1:(blank + 1)]
	      field_2 := field[(blank + 2):(*field + 1)]
	      locate(row,(*comment + 1))
	      writes(field_1,repl(" ",*field_2))
	      put(fieldl,field_1)
	      put(fieldl,field_2)
# Increase lnumber by 1
	      line_number := 1
# Return list with main part and wrapped part as its elements
	      return fieldl
	  }
#
# normal termination by <ret> or <arrow down>
	if byte == (char(13) | char(21)) then {
	      put(fieldl,field)
	      put(fieldl,"")
	      line_number := 1
	      return fieldl
	}
# normal termination by alt/e
	else {
	    if byte == char(14) then {
		  put(fieldl,field)
		  put(fieldl,"")
		  line_number := -1
		  return fieldl
	    }
	}
end
#
############################################################################
#								    #
#		     field editor edit_field()			    #
#								    #
############################################################################
#
# edit_field: user-defined function to divide a long string into
# lines and edit them as a field. uses: line() and all user-
# defined functions called by line().
# edit_field() accepts its data in a single string which is
# cracked apart before editing and put together afterwards.
# exceeding the size of the field (lnumber) by moving the
# cursor out of it, finishes the editing process.
#
# Annotation: edit_field() doesn't contain anything needed
# by line() and therefore should be removed if only line()
# is to be used.
#
# arguments to the function:
#	startline	: first line on the screen
#	lnumber 	: number of lines within field
#	byte_n		: number of bytes permitted within a line
#	label		: label to be displayed as field's headline
#	string		: string to be edited
	procedure edit_field(startline,lnumber,byte_n,label,string)

   local feld, item, lin, liste, n, res, rest

# Fail if "editing beyond the end of screen" is tried or byte_n is
# too big
	    if {(lnumber + startline > 24)  | (byte_n > 77)} then {
		write("ERROR: ILLEGAL ARGUMENT!")
		fail
	    }
	    n := 1
# Initialize feld as a list to contain string's contents
	    feld := list(lnumber,"")
# Crack apart string into byte_n-byte items.
	    while lin := string[1:byte_n] do {
# Assign every item's substring upto the last " " to field[n]
		feld[n] := lin[1:last(" ",lin)+1]
# Assign the rest to rest
		rest := lin[(last(" ",lin)+2):*lin+1]
# Delete the first byte_n bytes, then concatenate rest and string
		string[1:byte_n] := ""
		string := rest || string
		n +:= 1
	    }
	    feld[n] := string
# Display field's contents
	    n := 1
	    locate(startline-1,1)
	    writes(center(label,(byte_n-5)," "))
	    while n <= lnumber do {
		locate(startline-1+n,1)
		writes(feld[n])
		n +:= 1
	    }
# Begin editing process
	line_number := 1
	lin_nm := 1
# Stop if access to non permitted line number (0,>lnumber) is
# tried.
	while lin_nm >= 1 & lin_nm <= lnumber do {
#	    locate(23,40)
#	    write("ZEILENTYP: ",type(startline))
#	    read()
	    liste := line(startline,byte_n,1,"� ",feld[lin_nm])
	    feld[lin_nm] := liste[1]
	    locate(startline,1)
	    writes(feld[lin_nm],repl(" ",byte_n-*feld[lin_nm]+1))
	    startline +:= line_number
	    lin_nm +:= line_number
# If wrap demanded and the following line is capable to contain
# the wrapped rest of the line before and its original content,
# perform wrap.
	    if *liste[2] + *feld[lin_nm] <= byte_n then {
		feld[lin_nm] := liste[2] || " " || feld[lin_nm]
	    }
	}
# Set flag field_flag to -1/1 to indicate the direction
# in which the field has been quitted.
	if lin_nm <= 1 then field_flag := -1
	if lin_nm >= lnumber then field_flag := 1
# Put the string to be returned together of feld's elements.
	res := ""
	while item := pop(feld) do {
		res := res || " " || item
	}
	return res
end
#
# show_field: see edit field (except editing routines) for
# details.
	procedure show_field(startline,lnumber,byte_n,label,string)

   local feld, lin, n, rest

	    if {(lnumber + startline > 24)  | (byte_n > 77)} then {
		write("ERROR: ILLEGAL ARGUMENT!")
		fail
	    }
	    n := 1
	    feld := list(lnumber,"")
	    while lin := string[1:byte_n] do {
		feld[n] := lin[1:last(" ",lin)+1]
		rest := lin[(last(" ",lin)+2):*lin+1]
		string[1:byte_n] := ""
		string := rest || string
		n +:= 1
	    }
	    feld[n] := string
	    n := 1
	    locate(startline-1,1)
	    writes(center(label,(byte_n-5)," "))
	    while n <= lnumber do {
		locate(startline-1+n,1)
		writes(feld[n])
		n +:= 1
	    }
end
#
# edit_item(): function to edit the entry concerning one item
# of literature. This function makes it necessary to declare
# a fixed structure of every item within the function
# "#" separates the fields from each other. it shouldn't be
# contained in the data given to edit_item().
#
# Structure of an item:
#	TITLE
#	AUTHOR
#	YEAR
#	TYPE
#	COMMENT1
#	COMMENT2
	procedure edit_item(item)

   local ct, feld, felder, felder2, item2, labels, lin_e, n, zeile

	    felder := list()
	    felder2 := list()
	    labels := ["AUTHOR","TITLE","YEAR","TYPE","COMMENT1","COMMENT2"]
	    item ? {
		while feld := tab(upto("#")) do {
		    move(1)
		    put(felder,feld)
		    put(felder2,feld)
		}
	    }
	    zeile := 2
# Display the fields
	    n := 1
	    while feld := get(felder) do {
		show_field(zeile,2,70,labels[n],feld)
		n +:= 1
		zeile +:= 4
	    }
# Start editing process
	ct := 1
	zeile := 2
	while zeile >= 2 & zeile <= 22 do {
	    felder2[ct] := edit_field(zeile,2,70,labels[ct],trim(felder2[ct]))
	    ct +:= field_flag
	    if field_flag = 1 then zeile +:= 4 else zeile -:= 4
	}
# Indicate the direction in which item has been quitted using
# global variable item_flag
	if zeile < 2 then item_flag := -1 else item_flag := 1
	item2 := ""
# Format result: item's fields are brought up to a standard length
# of 140 bytes using blanks.
	while lin_e := get(felder2) do {
	    item2 ||:= lin_e || repl(" ",(140 - *lin_e)) || "#"
	}
	return item2
end
#
# brightwrite(string): function to highlight a string
	procedure brightwrite(string)

   local highl, normal

		highl := char(27) || "[7m"
		normal := char(27) || "[0m"
		writes(highl,string,normal)
end
#
# findlist(wlist,item): function to return the first
# position of item in wlist.
	procedure findlist(wlist,item)

   local n

	n := 1
	while n <= *wlist do {
	    if wlist[n] == item then return n
	    n +:= 1
	}
	fail
end
#
# menue(header,wlist,klist): function to build up a menuE
# Arguments: header, list of options (wlist) and list of
# shorthand keys (key list).
# because menue() fails if a non defined key (not contained
# in klist, no arrow key), calls to menue() should be made
# within a loop terminated on menue()'s success, see below
# main().
	procedure menue(header,wlist,klist)

   local add, byte, n

		locate(4,10)
		writes(header)
		n := 5
		while (n - 4) <= *wlist do {
		    locate(n,10)
		    writes(wlist[n-4])
		    n +:= 1
		}
		n := 5
		locate(n,10)
		brightwrite(wlist[n-4])
		while byte := getch() & {
		     byte == (char(21) | char(14)) | findlist(klist,byte)
		 }
		do {
# If byte Is element of klist (shorthandkey) the element number
# within the list + 4 indicates option.
		    if add := findlist(klist,byte) then {
			locate(n,10)
			writes(wlist[n-4])
			n := 4 + add
			locate(n,10)
			brightwrite(wlist[n-4])
		    }
# else increase/decrease actual element by one.
		    else {
			if byte == char(14) then add := -1
			if byte == char(21) then add := 1
			locate(n,10)
			writes(wlist[n-4])
			n +:= add
			if (n - 4) < 1 then n +:= 1
			if (n - 4) > *wlist then n -:= 1
			locate(n,10)
			brightwrite(wlist[n-4])
		    }
		}
		if byte == char(13) then return wlist[(n-4)] else fail
end
#
# in_itemm(): function to create new items. Standard file is literat.fil
# The new items are handled as a sequential file which is added to the
# existing file when input process is finished.
	procedure in_itemm()

   local answer, count, items, itnum, out_item

		item_flag := 1
		items := list(200,"######")
		itnum := 0
		repeat {
		     itnum +:= item_flag
		     if itnum < 1 then itnum := 1
		     items[itnum] := edit_item(items[itnum])
		     writes(char(27),"[2J")
		     write("NEW ITEM? Yy/Nn!")
		     answer := getch()
		     if answer == ("n" | "N") then break
		}
		count := 1
		out_item := open("literat.fil","a")
		while items[count] ~== "######" do {
		    writes(out_item,items[count])
		    count +:= 1
		}
		close(out_item)
end
#
# turn_over(): view and edit literat.fil item by item
	procedure turn_over()

   local answer, in_item, it, out_item

		in_item := open("literat.fil","r")
		out_item := open("literat2.fil","w")
		repeat {
		    it := reads(in_item,846)
		    it := edit_item(it)
		    writes(out_item,it)
		    writes(char(27),"[2J")
		    write("NEW ITEM? Yy/Nn!")
		    answer := getch()
		    if answer == ("n" | "N") then break
# If item_flag is -1 seek -1692 (2 items) to access the beginning of the
# previous item because the internal file pointer points to the end of
# the actual item.
		    if item_flag == -1 then seek(in_item,where(in_item)-1692)
		}
		close(in_item)
		close(out_item)
end
#
# del(num) remove numth item from filE
	procedure del()

   local fil, in_item, itm, n, num, out_item

	    writes(char(27),"[2J")
	    write("NUMBER OF ITEM TO BE REMOVED?")
	    num := read()
	    write("READING...")
	    fil := list()
	    in_item := open("literat.fil","r")
	    while itm := reads(in_item,846) do {
		put(fil,itm)
	    }
	    close(in_item)
	    write("START OVERWRITE PROCESS...")
	    n := num
	    while n < *fil do {
		fil[n] := fil[n+1]
		n +:= 1
	    }
	    fil[*fil] := ""
	    out_item := open("literat2.fil","w")
	    write("WRITING...")
	    while itm := get(fil) & itm ~== "" do {
		writes(out_item,itm)
	    }
	    close(out_item)
	    write("DONE...")
end
#
# alpha: sorting in alphabetical order
	procedure alpha()

   local fil, in_item, itm, out_item

	writes(char(27),"[2J")
	write("READING...")
	fil := list()
	in_item := open("literat.fil","r")
	while itm := reads(in_item,846) do {
	    put(fil,itm)
	}
	close(in_item)
	write("ARRANGING DATA IN ALPHABETICAL ORDER...")
	fil := sort(fil)
	write("WRITING...")
	out_item := open("literat2.fil","w")
	while itm := get(fil) & itm ~== "" do {
	    writes(out_item,itm)
	}
	close(out_item)
	write("DONE...")
end
#
# m_adress: function to generate a file with arguments to the seek()
# function. The file (adress.fil) will be used for sequential
# search in the computer's ram, (function (query()). The results enable
# the seek() function to place the internal file pointer on the desired
# item in literat.fil.
	procedure m_adress()

   local a, adr, b, in_item, item, m, n, out_adr, out_line, wlist, wlist_2

		out_line := ""
		adr := edit_field(4,10,70,"FORMAT: <WORD>;<WORD>;ETC.","")
		writes(char(27),"[2J")
		write("GENERATING WORD LIST...")
		wlist := list()
		n := 1
		adr ? {
		    while put(wlist,tab(upto(";"))) do {
			move(1)
			write("ACTUAL WORD: ",wlist[n])
			n +:= 1
		    }
		}
		in_item := open("literat.fil","r")
		n := 1

		wlist_2 := copy(wlist)
# Insert ; between word in wlist_2 and seqence of record numbers
# to be found out later.
		while n <= *wlist_2 do {
		    wlist_2[n] ||:= ";"
		     n +:= 1
		}
		n := 1
		while n <= *wlist do {
		    write("COMPARING WORD NUMBER: ",n,".")
# counter m: indicates record number
		    m := 1
		    while item := reads(in_item,846) do {
			if find(wlist[n],item) then {
			    wlist_2[n] ||:= m || ";"
			}
			m +:= 1
		    }
		    wlist_2[n] ? {
			a := tab(upto(";"))
			b := tab(0)
		    }
		    if b == ";" then b := ";0"
		    wlist_2[n] := a || b
		    out_line ||:= wlist_2[n] || ":"
# When every item has been compared with wlist[n], move file
# pointer to the beginning of in_item and increase n by 1.
		    seek(in_item,1)
		    n +:= 1
		}
		close(in_item)
# Remove trailing blank if any
		if out_line[1] := " " then {
		    out_line := out_line[2:(*out_line+1)]
		}
		write("WRITING ADRESS FILE")
		out_adr := open("adress.fil","a")
		writes(out_adr,out_line)
		close(out_adr)
		write("OK")
end
#
# query(): find items using the numbers in adress.fil * 846 as
# arguments to the seek() function
	procedure query()

   local byte, in_item, in_line, in_query, it_key, kkey, out_item, word, wrd

	    writes(char(27),"[2J")
	    in_query := open("adress.fil","r")
	    in_line := read(in_query)
	    close(in_query)
	    in_item := open("literat.fil","r")
	    out_item := open("literat2.fil","a")
	    wrd := line(10,20,0,"TYPE WORD TO BE LOOKED FOR: ","")
	    word := wrd[1]
	    if byte := find(word,in_line) then {
		in_line ? {
		    move(byte)
		    it_key := tab(upto(":"))
		}
	     }
	     else {
		 locate(10,25)
		 writes("ERROR: UNKNOWN WORD! PRESS KEY!")
		 getch()
		 fail
	     }
# place internal cursor behind the first ; to get the first
# number:
	     it_key := it_key[find(";",it_key)+1:*it_key+1]
	     it_key ? {
		 while kkey := tab(upto(";")) do {
		     if kkey <= 0 then {
			locate(10,25)
			writes("ERROR: UNKNOWN WORD! PRESS KEY!")
			getch()
			fail
		     }
		     seek(in_item,(kkey-1)*846)
		     writes(out_item,edit_item(reads(in_item,846)))
		     move(1)
		 }
	     }
	     close(in_item)
	     close(out_item)
	     write("OK")
end
#
# main program. see the description of the program's functionS
# at the beginning of the source code and of every user-defined
# function if you are in doubt how to use them.
#
    procedure main()

    local alist, blist, opt

    newkey()
    alist := {
	["iNPUT","tURN OVER ITEMS","aDRESS FILE","qUERY","dEL","AlPHA","eND"]
    }
    blist := ["i","t","a","q","d","l","e"]
    repeat {
      repeat {
	writes(char(27),"[2J")
	locate(1,10)
	write("LITERAT:    EASY DATABASE SYSTEM")
	locate(2,10)
	write("WRITTEN BY: MATTHIAS HEESCH 1992")
	if opt := menue("MENUE",alist,blist) then break
      }
      writes(char(27),"[2J")
      case opt of {
	"iNPUT" : in_itemm()
	"tURN OVER ITEMS" : turn_over()
	"aDRESS FILE" : m_adress()
	"qUERY" : query()
	"dEL" : del()
	"AlPHA" : alpha()
	"eND" : break
      }
    }
end