terminal_interface-curses.adb.m4 81 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503
  1. -- -*- ada -*-
  2. define(`HTMLNAME',`terminal_interface-curses__adb.htm')dnl
  3. include(M4MACRO)------------------------------------------------------------------------------
  4. -- --
  5. -- GNAT ncurses Binding --
  6. -- --
  7. -- Terminal_Interface.Curses --
  8. -- --
  9. -- B O D Y --
  10. -- --
  11. ------------------------------------------------------------------------------
  12. -- Copyright (c) 1998-2007,2008 Free Software Foundation, Inc. --
  13. -- --
  14. -- Permission is hereby granted, free of charge, to any person obtaining a --
  15. -- copy of this software and associated documentation files (the --
  16. -- "Software"), to deal in the Software without restriction, including --
  17. -- without limitation the rights to use, copy, modify, merge, publish, --
  18. -- distribute, distribute with modifications, sublicense, and/or sell --
  19. -- copies of the Software, and to permit persons to whom the Software is --
  20. -- furnished to do so, subject to the following conditions: --
  21. -- --
  22. -- The above copyright notice and this permission notice shall be included --
  23. -- in all copies or substantial portions of the Software. --
  24. -- --
  25. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
  26. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
  27. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
  28. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
  29. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
  30. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
  31. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
  32. -- --
  33. -- Except as contained in this notice, the name(s) of the above copyright --
  34. -- holders shall not be used in advertising or otherwise to promote the --
  35. -- sale, use or other dealings in this Software without prior written --
  36. -- authorization. --
  37. ------------------------------------------------------------------------------
  38. -- Author: Juergen Pfeifer, 1996
  39. -- Version Control:
  40. -- $Revision: 1.5 $
  41. -- $Date: 2008/07/26 18:46:32 $
  42. -- Binding Version 01.00
  43. ------------------------------------------------------------------------------
  44. with System;
  45. with Terminal_Interface.Curses.Aux;
  46. with Interfaces.C; use Interfaces.C;
  47. with Interfaces.C.Strings; use Interfaces.C.Strings;
  48. with Ada.Characters.Handling; use Ada.Characters.Handling;
  49. with Ada.Strings.Fixed;
  50. package body Terminal_Interface.Curses is
  51. use Aux;
  52. use type System.Bit_Order;
  53. package ASF renames Ada.Strings.Fixed;
  54. type chtype_array is array (size_t range <>)
  55. of aliased Attributed_Character;
  56. pragma Convention (C, chtype_array);
  57. ------------------------------------------------------------------------------
  58. function Key_Name (Key : in Real_Key_Code) return String
  59. is
  60. function Keyname (K : C_Int) return chars_ptr;
  61. pragma Import (C, Keyname, "keyname");
  62. Ch : Character;
  63. begin
  64. if Key <= Character'Pos (Character'Last) then
  65. Ch := Character'Val (Key);
  66. if Is_Control (Ch) then
  67. return Un_Control (Attributed_Character'(Ch => Ch,
  68. Color => Color_Pair'First,
  69. Attr => Normal_Video));
  70. elsif Is_Graphic (Ch) then
  71. declare
  72. S : String (1 .. 1);
  73. begin
  74. S (1) := Ch;
  75. return S;
  76. end;
  77. else
  78. return "";
  79. end if;
  80. else
  81. return Fill_String (Keyname (C_Int (Key)));
  82. end if;
  83. end Key_Name;
  84. procedure Key_Name (Key : in Real_Key_Code;
  85. Name : out String)
  86. is
  87. begin
  88. ASF.Move (Key_Name (Key), Name);
  89. end Key_Name;
  90. ------------------------------------------------------------------------------
  91. procedure Init_Screen
  92. is
  93. function Initscr return Window;
  94. pragma Import (C, Initscr, "initscr");
  95. W : Window;
  96. begin
  97. W := Initscr;
  98. if W = Null_Window then
  99. raise Curses_Exception;
  100. end if;
  101. end Init_Screen;
  102. procedure End_Windows
  103. is
  104. function Endwin return C_Int;
  105. pragma Import (C, Endwin, "endwin");
  106. begin
  107. if Endwin = Curses_Err then
  108. raise Curses_Exception;
  109. end if;
  110. end End_Windows;
  111. function Is_End_Window return Boolean
  112. is
  113. function Isendwin return Curses_Bool;
  114. pragma Import (C, Isendwin, "isendwin");
  115. begin
  116. if Isendwin = Curses_Bool_False then
  117. return False;
  118. else
  119. return True;
  120. end if;
  121. end Is_End_Window;
  122. ------------------------------------------------------------------------------
  123. procedure Move_Cursor (Win : in Window := Standard_Window;
  124. Line : in Line_Position;
  125. Column : in Column_Position)
  126. is
  127. function Wmove (Win : Window;
  128. Line : C_Int;
  129. Column : C_Int
  130. ) return C_Int;
  131. pragma Import (C, Wmove, "wmove");
  132. begin
  133. if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
  134. raise Curses_Exception;
  135. end if;
  136. end Move_Cursor;
  137. ------------------------------------------------------------------------------
  138. procedure Add (Win : in Window := Standard_Window;
  139. Ch : in Attributed_Character)
  140. is
  141. function Waddch (W : Window;
  142. Ch : C_Chtype) return C_Int;
  143. pragma Import (C, Waddch, "waddch");
  144. begin
  145. if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
  146. raise Curses_Exception;
  147. end if;
  148. end Add;
  149. procedure Add (Win : in Window := Standard_Window;
  150. Ch : in Character)
  151. is
  152. begin
  153. Add (Win,
  154. Attributed_Character'(Ch => Ch,
  155. Color => Color_Pair'First,
  156. Attr => Normal_Video));
  157. end Add;
  158. procedure Add
  159. (Win : in Window := Standard_Window;
  160. Line : in Line_Position;
  161. Column : in Column_Position;
  162. Ch : in Attributed_Character)
  163. is
  164. function mvwaddch (W : Window;
  165. Y : C_Int;
  166. X : C_Int;
  167. Ch : C_Chtype) return C_Int;
  168. pragma Import (C, mvwaddch, "mvwaddch");
  169. begin
  170. if mvwaddch (Win, C_Int (Line),
  171. C_Int (Column),
  172. AttrChar_To_Chtype (Ch)) = Curses_Err then
  173. raise Curses_Exception;
  174. end if;
  175. end Add;
  176. procedure Add
  177. (Win : in Window := Standard_Window;
  178. Line : in Line_Position;
  179. Column : in Column_Position;
  180. Ch : in Character)
  181. is
  182. begin
  183. Add (Win,
  184. Line,
  185. Column,
  186. Attributed_Character'(Ch => Ch,
  187. Color => Color_Pair'First,
  188. Attr => Normal_Video));
  189. end Add;
  190. procedure Add_With_Immediate_Echo
  191. (Win : in Window := Standard_Window;
  192. Ch : in Attributed_Character)
  193. is
  194. function Wechochar (W : Window;
  195. Ch : C_Chtype) return C_Int;
  196. pragma Import (C, Wechochar, "wechochar");
  197. begin
  198. if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
  199. raise Curses_Exception;
  200. end if;
  201. end Add_With_Immediate_Echo;
  202. procedure Add_With_Immediate_Echo
  203. (Win : in Window := Standard_Window;
  204. Ch : in Character)
  205. is
  206. begin
  207. Add_With_Immediate_Echo
  208. (Win,
  209. Attributed_Character'(Ch => Ch,
  210. Color => Color_Pair'First,
  211. Attr => Normal_Video));
  212. end Add_With_Immediate_Echo;
  213. ------------------------------------------------------------------------------
  214. function Create (Number_Of_Lines : Line_Count;
  215. Number_Of_Columns : Column_Count;
  216. First_Line_Position : Line_Position;
  217. First_Column_Position : Column_Position) return Window
  218. is
  219. function Newwin (Number_Of_Lines : C_Int;
  220. Number_Of_Columns : C_Int;
  221. First_Line_Position : C_Int;
  222. First_Column_Position : C_Int) return Window;
  223. pragma Import (C, Newwin, "newwin");
  224. W : Window;
  225. begin
  226. W := Newwin (C_Int (Number_Of_Lines),
  227. C_Int (Number_Of_Columns),
  228. C_Int (First_Line_Position),
  229. C_Int (First_Column_Position));
  230. if W = Null_Window then
  231. raise Curses_Exception;
  232. end if;
  233. return W;
  234. end Create;
  235. procedure Delete (Win : in out Window)
  236. is
  237. function Wdelwin (W : Window) return C_Int;
  238. pragma Import (C, Wdelwin, "delwin");
  239. begin
  240. if Wdelwin (Win) = Curses_Err then
  241. raise Curses_Exception;
  242. end if;
  243. Win := Null_Window;
  244. end Delete;
  245. function Sub_Window
  246. (Win : Window := Standard_Window;
  247. Number_Of_Lines : Line_Count;
  248. Number_Of_Columns : Column_Count;
  249. First_Line_Position : Line_Position;
  250. First_Column_Position : Column_Position) return Window
  251. is
  252. function Subwin
  253. (Win : Window;
  254. Number_Of_Lines : C_Int;
  255. Number_Of_Columns : C_Int;
  256. First_Line_Position : C_Int;
  257. First_Column_Position : C_Int) return Window;
  258. pragma Import (C, Subwin, "subwin");
  259. W : Window;
  260. begin
  261. W := Subwin (Win,
  262. C_Int (Number_Of_Lines),
  263. C_Int (Number_Of_Columns),
  264. C_Int (First_Line_Position),
  265. C_Int (First_Column_Position));
  266. if W = Null_Window then
  267. raise Curses_Exception;
  268. end if;
  269. return W;
  270. end Sub_Window;
  271. function Derived_Window
  272. (Win : Window := Standard_Window;
  273. Number_Of_Lines : Line_Count;
  274. Number_Of_Columns : Column_Count;
  275. First_Line_Position : Line_Position;
  276. First_Column_Position : Column_Position) return Window
  277. is
  278. function Derwin
  279. (Win : Window;
  280. Number_Of_Lines : C_Int;
  281. Number_Of_Columns : C_Int;
  282. First_Line_Position : C_Int;
  283. First_Column_Position : C_Int) return Window;
  284. pragma Import (C, Derwin, "derwin");
  285. W : Window;
  286. begin
  287. W := Derwin (Win,
  288. C_Int (Number_Of_Lines),
  289. C_Int (Number_Of_Columns),
  290. C_Int (First_Line_Position),
  291. C_Int (First_Column_Position));
  292. if W = Null_Window then
  293. raise Curses_Exception;
  294. end if;
  295. return W;
  296. end Derived_Window;
  297. function Duplicate (Win : Window) return Window
  298. is
  299. function Dupwin (Win : Window) return Window;
  300. pragma Import (C, Dupwin, "dupwin");
  301. W : constant Window := Dupwin (Win);
  302. begin
  303. if W = Null_Window then
  304. raise Curses_Exception;
  305. end if;
  306. return W;
  307. end Duplicate;
  308. procedure Move_Window (Win : in Window;
  309. Line : in Line_Position;
  310. Column : in Column_Position)
  311. is
  312. function Mvwin (Win : Window;
  313. Line : C_Int;
  314. Column : C_Int) return C_Int;
  315. pragma Import (C, Mvwin, "mvwin");
  316. begin
  317. if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
  318. raise Curses_Exception;
  319. end if;
  320. end Move_Window;
  321. procedure Move_Derived_Window (Win : in Window;
  322. Line : in Line_Position;
  323. Column : in Column_Position)
  324. is
  325. function Mvderwin (Win : Window;
  326. Line : C_Int;
  327. Column : C_Int) return C_Int;
  328. pragma Import (C, Mvderwin, "mvderwin");
  329. begin
  330. if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
  331. raise Curses_Exception;
  332. end if;
  333. end Move_Derived_Window;
  334. procedure Set_Synch_Mode (Win : in Window := Standard_Window;
  335. Mode : in Boolean := False)
  336. is
  337. function Syncok (Win : Window;
  338. Mode : Curses_Bool) return C_Int;
  339. pragma Import (C, Syncok, "syncok");
  340. begin
  341. if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
  342. raise Curses_Exception;
  343. end if;
  344. end Set_Synch_Mode;
  345. ------------------------------------------------------------------------------
  346. procedure Add (Win : in Window := Standard_Window;
  347. Str : in String;
  348. Len : in Integer := -1)
  349. is
  350. function Waddnstr (Win : Window;
  351. Str : char_array;
  352. Len : C_Int := -1) return C_Int;
  353. pragma Import (C, Waddnstr, "waddnstr");
  354. Txt : char_array (0 .. Str'Length);
  355. Length : size_t;
  356. begin
  357. To_C (Str, Txt, Length);
  358. if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
  359. raise Curses_Exception;
  360. end if;
  361. end Add;
  362. procedure Add
  363. (Win : in Window := Standard_Window;
  364. Line : in Line_Position;
  365. Column : in Column_Position;
  366. Str : in String;
  367. Len : in Integer := -1)
  368. is
  369. begin
  370. Move_Cursor (Win, Line, Column);
  371. Add (Win, Str, Len);
  372. end Add;
  373. ------------------------------------------------------------------------------
  374. procedure Add
  375. (Win : in Window := Standard_Window;
  376. Str : in Attributed_String;
  377. Len : in Integer := -1)
  378. is
  379. function Waddchnstr (Win : Window;
  380. Str : chtype_array;
  381. Len : C_Int := -1) return C_Int;
  382. pragma Import (C, Waddchnstr, "waddchnstr");
  383. Txt : chtype_array (0 .. Str'Length);
  384. begin
  385. for Length in 1 .. size_t (Str'Length) loop
  386. Txt (Length - 1) := Str (Natural (Length));
  387. end loop;
  388. Txt (Str'Length) := Default_Character;
  389. if Waddchnstr (Win,
  390. Txt,
  391. C_Int (Len)) = Curses_Err then
  392. raise Curses_Exception;
  393. end if;
  394. end Add;
  395. procedure Add
  396. (Win : in Window := Standard_Window;
  397. Line : in Line_Position;
  398. Column : in Column_Position;
  399. Str : in Attributed_String;
  400. Len : in Integer := -1)
  401. is
  402. begin
  403. Move_Cursor (Win, Line, Column);
  404. Add (Win, Str, Len);
  405. end Add;
  406. ------------------------------------------------------------------------------
  407. procedure Border
  408. (Win : in Window := Standard_Window;
  409. Left_Side_Symbol : in Attributed_Character := Default_Character;
  410. Right_Side_Symbol : in Attributed_Character := Default_Character;
  411. Top_Side_Symbol : in Attributed_Character := Default_Character;
  412. Bottom_Side_Symbol : in Attributed_Character := Default_Character;
  413. Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
  414. Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
  415. Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
  416. Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
  417. is
  418. function Wborder (W : Window;
  419. LS : C_Chtype;
  420. RS : C_Chtype;
  421. TS : C_Chtype;
  422. BS : C_Chtype;
  423. ULC : C_Chtype;
  424. URC : C_Chtype;
  425. LLC : C_Chtype;
  426. LRC : C_Chtype) return C_Int;
  427. pragma Import (C, Wborder, "wborder");
  428. begin
  429. if Wborder (Win,
  430. AttrChar_To_Chtype (Left_Side_Symbol),
  431. AttrChar_To_Chtype (Right_Side_Symbol),
  432. AttrChar_To_Chtype (Top_Side_Symbol),
  433. AttrChar_To_Chtype (Bottom_Side_Symbol),
  434. AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
  435. AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
  436. AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
  437. AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
  438. ) = Curses_Err
  439. then
  440. raise Curses_Exception;
  441. end if;
  442. end Border;
  443. procedure Box
  444. (Win : in Window := Standard_Window;
  445. Vertical_Symbol : in Attributed_Character := Default_Character;
  446. Horizontal_Symbol : in Attributed_Character := Default_Character)
  447. is
  448. begin
  449. Border (Win,
  450. Vertical_Symbol, Vertical_Symbol,
  451. Horizontal_Symbol, Horizontal_Symbol);
  452. end Box;
  453. procedure Horizontal_Line
  454. (Win : in Window := Standard_Window;
  455. Line_Size : in Natural;
  456. Line_Symbol : in Attributed_Character := Default_Character)
  457. is
  458. function Whline (W : Window;
  459. Ch : C_Chtype;
  460. Len : C_Int) return C_Int;
  461. pragma Import (C, Whline, "whline");
  462. begin
  463. if Whline (Win,
  464. AttrChar_To_Chtype (Line_Symbol),
  465. C_Int (Line_Size)) = Curses_Err then
  466. raise Curses_Exception;
  467. end if;
  468. end Horizontal_Line;
  469. procedure Vertical_Line
  470. (Win : in Window := Standard_Window;
  471. Line_Size : in Natural;
  472. Line_Symbol : in Attributed_Character := Default_Character)
  473. is
  474. function Wvline (W : Window;
  475. Ch : C_Chtype;
  476. Len : C_Int) return C_Int;
  477. pragma Import (C, Wvline, "wvline");
  478. begin
  479. if Wvline (Win,
  480. AttrChar_To_Chtype (Line_Symbol),
  481. C_Int (Line_Size)) = Curses_Err then
  482. raise Curses_Exception;
  483. end if;
  484. end Vertical_Line;
  485. ------------------------------------------------------------------------------
  486. function Get_Keystroke (Win : Window := Standard_Window)
  487. return Real_Key_Code
  488. is
  489. function Wgetch (W : Window) return C_Int;
  490. pragma Import (C, Wgetch, "wgetch");
  491. C : constant C_Int := Wgetch (Win);
  492. begin
  493. if C = Curses_Err then
  494. return Key_None;
  495. else
  496. return Real_Key_Code (C);
  497. end if;
  498. end Get_Keystroke;
  499. procedure Undo_Keystroke (Key : in Real_Key_Code)
  500. is
  501. function Ungetch (Ch : C_Int) return C_Int;
  502. pragma Import (C, Ungetch, "ungetch");
  503. begin
  504. if Ungetch (C_Int (Key)) = Curses_Err then
  505. raise Curses_Exception;
  506. end if;
  507. end Undo_Keystroke;
  508. function Has_Key (Key : Special_Key_Code) return Boolean
  509. is
  510. function Haskey (Key : C_Int) return C_Int;
  511. pragma Import (C, Haskey, "has_key");
  512. begin
  513. if Haskey (C_Int (Key)) = Curses_False then
  514. return False;
  515. else
  516. return True;
  517. end if;
  518. end Has_Key;
  519. function Is_Function_Key (Key : Special_Key_Code) return Boolean
  520. is
  521. L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
  522. Natural (Function_Key_Number'Last));
  523. begin
  524. if (Key >= Key_F0) and then (Key <= L) then
  525. return True;
  526. else
  527. return False;
  528. end if;
  529. end Is_Function_Key;
  530. function Function_Key (Key : Real_Key_Code)
  531. return Function_Key_Number
  532. is
  533. begin
  534. if Is_Function_Key (Key) then
  535. return Function_Key_Number (Key - Key_F0);
  536. else
  537. raise Constraint_Error;
  538. end if;
  539. end Function_Key;
  540. function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
  541. is
  542. begin
  543. return Real_Key_Code (Natural (Key_F0) + Natural (Key));
  544. end Function_Key_Code;
  545. ------------------------------------------------------------------------------
  546. procedure Standout (Win : Window := Standard_Window;
  547. On : Boolean := True)
  548. is
  549. function wstandout (Win : Window) return C_Int;
  550. pragma Import (C, wstandout, "wstandout");
  551. function wstandend (Win : Window) return C_Int;
  552. pragma Import (C, wstandend, "wstandend");
  553. Err : C_Int;
  554. begin
  555. if On then
  556. Err := wstandout (Win);
  557. else
  558. Err := wstandend (Win);
  559. end if;
  560. if Err = Curses_Err then
  561. raise Curses_Exception;
  562. end if;
  563. end Standout;
  564. procedure Switch_Character_Attribute
  565. (Win : in Window := Standard_Window;
  566. Attr : in Character_Attribute_Set := Normal_Video;
  567. On : in Boolean := True)
  568. is
  569. function Wattron (Win : Window;
  570. C_Attr : C_AttrType) return C_Int;
  571. pragma Import (C, Wattron, "wattr_on");
  572. function Wattroff (Win : Window;
  573. C_Attr : C_AttrType) return C_Int;
  574. pragma Import (C, Wattroff, "wattr_off");
  575. -- In Ada we use the On Boolean to control whether or not we want to
  576. -- switch on or off the attributes in the set.
  577. Err : C_Int;
  578. AC : constant Attributed_Character := (Ch => Character'First,
  579. Color => Color_Pair'First,
  580. Attr => Attr);
  581. begin
  582. if On then
  583. Err := Wattron (Win, AttrChar_To_AttrType (AC));
  584. else
  585. Err := Wattroff (Win, AttrChar_To_AttrType (AC));
  586. end if;
  587. if Err = Curses_Err then
  588. raise Curses_Exception;
  589. end if;
  590. end Switch_Character_Attribute;
  591. procedure Set_Character_Attributes
  592. (Win : in Window := Standard_Window;
  593. Attr : in Character_Attribute_Set := Normal_Video;
  594. Color : in Color_Pair := Color_Pair'First)
  595. is
  596. function Wattrset (Win : Window;
  597. C_Attr : C_AttrType) return C_Int;
  598. pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
  599. begin
  600. if Wattrset (Win,
  601. AttrChar_To_AttrType (Attributed_Character'
  602. (Ch => Character'First,
  603. Color => Color,
  604. Attr => Attr))) = Curses_Err then
  605. raise Curses_Exception;
  606. end if;
  607. end Set_Character_Attributes;
  608. function Get_Character_Attribute (Win : Window := Standard_Window)
  609. return Character_Attribute_Set
  610. is
  611. function Wattrget (Win : Window;
  612. Atr : access C_AttrType;
  613. Col : access C_Short;
  614. Opt : System.Address) return C_Int;
  615. pragma Import (C, Wattrget, "wattr_get");
  616. Attr : aliased C_AttrType;
  617. Col : aliased C_Short;
  618. Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
  619. System.Null_Address);
  620. Ch : Attributed_Character;
  621. begin
  622. if Res = Curses_Ok then
  623. Ch := AttrType_To_AttrChar (Attr);
  624. return Ch.Attr;
  625. else
  626. raise Curses_Exception;
  627. end if;
  628. end Get_Character_Attribute;
  629. function Get_Character_Attribute (Win : Window := Standard_Window)
  630. return Color_Pair
  631. is
  632. function Wattrget (Win : Window;
  633. Atr : access C_AttrType;
  634. Col : access C_Short;
  635. Opt : System.Address) return C_Int;
  636. pragma Import (C, Wattrget, "wattr_get");
  637. Attr : aliased C_AttrType;
  638. Col : aliased C_Short;
  639. Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
  640. System.Null_Address);
  641. Ch : Attributed_Character;
  642. begin
  643. if Res = Curses_Ok then
  644. Ch := AttrType_To_AttrChar (Attr);
  645. return Ch.Color;
  646. else
  647. raise Curses_Exception;
  648. end if;
  649. end Get_Character_Attribute;
  650. procedure Set_Color (Win : in Window := Standard_Window;
  651. Pair : in Color_Pair)
  652. is
  653. function Wset_Color (Win : Window;
  654. Color : C_Short;
  655. Opts : C_Void_Ptr) return C_Int;
  656. pragma Import (C, Wset_Color, "wcolor_set");
  657. begin
  658. if Wset_Color (Win,
  659. C_Short (Pair),
  660. C_Void_Ptr (System.Null_Address)) = Curses_Err then
  661. raise Curses_Exception;
  662. end if;
  663. end Set_Color;
  664. procedure Change_Attributes
  665. (Win : in Window := Standard_Window;
  666. Count : in Integer := -1;
  667. Attr : in Character_Attribute_Set := Normal_Video;
  668. Color : in Color_Pair := Color_Pair'First)
  669. is
  670. function Wchgat (Win : Window;
  671. Cnt : C_Int;
  672. Attr : C_AttrType;
  673. Color : C_Short;
  674. Opts : System.Address := System.Null_Address)
  675. return C_Int;
  676. pragma Import (C, Wchgat, "wchgat");
  677. Ch : constant Attributed_Character :=
  678. (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
  679. begin
  680. if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
  681. C_Short (Color)) = Curses_Err then
  682. raise Curses_Exception;
  683. end if;
  684. end Change_Attributes;
  685. procedure Change_Attributes
  686. (Win : in Window := Standard_Window;
  687. Line : in Line_Position := Line_Position'First;
  688. Column : in Column_Position := Column_Position'First;
  689. Count : in Integer := -1;
  690. Attr : in Character_Attribute_Set := Normal_Video;
  691. Color : in Color_Pair := Color_Pair'First)
  692. is
  693. begin
  694. Move_Cursor (Win, Line, Column);
  695. Change_Attributes (Win, Count, Attr, Color);
  696. end Change_Attributes;
  697. ------------------------------------------------------------------------------
  698. procedure Beep
  699. is
  700. function Beeper return C_Int;
  701. pragma Import (C, Beeper, "beep");
  702. begin
  703. if Beeper = Curses_Err then
  704. raise Curses_Exception;
  705. end if;
  706. end Beep;
  707. procedure Flash_Screen
  708. is
  709. function Flash return C_Int;
  710. pragma Import (C, Flash, "flash");
  711. begin
  712. if Flash = Curses_Err then
  713. raise Curses_Exception;
  714. end if;
  715. end Flash_Screen;
  716. ------------------------------------------------------------------------------
  717. procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
  718. is
  719. function Cbreak return C_Int;
  720. pragma Import (C, Cbreak, "cbreak");
  721. function NoCbreak return C_Int;
  722. pragma Import (C, NoCbreak, "nocbreak");
  723. Err : C_Int;
  724. begin
  725. if SwitchOn then
  726. Err := Cbreak;
  727. else
  728. Err := NoCbreak;
  729. end if;
  730. if Err = Curses_Err then
  731. raise Curses_Exception;
  732. end if;
  733. end Set_Cbreak_Mode;
  734. procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
  735. is
  736. function Raw return C_Int;
  737. pragma Import (C, Raw, "raw");
  738. function NoRaw return C_Int;
  739. pragma Import (C, NoRaw, "noraw");
  740. Err : C_Int;
  741. begin
  742. if SwitchOn then
  743. Err := Raw;
  744. else
  745. Err := NoRaw;
  746. end if;
  747. if Err = Curses_Err then
  748. raise Curses_Exception;
  749. end if;
  750. end Set_Raw_Mode;
  751. procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
  752. is
  753. function Echo return C_Int;
  754. pragma Import (C, Echo, "echo");
  755. function NoEcho return C_Int;
  756. pragma Import (C, NoEcho, "noecho");
  757. Err : C_Int;
  758. begin
  759. if SwitchOn then
  760. Err := Echo;
  761. else
  762. Err := NoEcho;
  763. end if;
  764. if Err = Curses_Err then
  765. raise Curses_Exception;
  766. end if;
  767. end Set_Echo_Mode;
  768. procedure Set_Meta_Mode (Win : in Window := Standard_Window;
  769. SwitchOn : in Boolean := True)
  770. is
  771. function Meta (W : Window; Mode : Curses_Bool) return C_Int;
  772. pragma Import (C, Meta, "meta");
  773. begin
  774. if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
  775. raise Curses_Exception;
  776. end if;
  777. end Set_Meta_Mode;
  778. procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
  779. SwitchOn : in Boolean := True)
  780. is
  781. function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
  782. pragma Import (C, Keypad, "keypad");
  783. begin
  784. if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
  785. raise Curses_Exception;
  786. end if;
  787. end Set_KeyPad_Mode;
  788. function Get_KeyPad_Mode (Win : in Window := Standard_Window)
  789. return Boolean
  790. is
  791. function Is_Keypad (W : Window) return Curses_Bool;
  792. pragma Import (C, Is_Keypad, "is_keypad");
  793. begin
  794. return (Is_Keypad (Win) /= Curses_Bool_False);
  795. end Get_KeyPad_Mode;
  796. procedure Half_Delay (Amount : in Half_Delay_Amount)
  797. is
  798. function Halfdelay (Amount : C_Int) return C_Int;
  799. pragma Import (C, Halfdelay, "halfdelay");
  800. begin
  801. if Halfdelay (C_Int (Amount)) = Curses_Err then
  802. raise Curses_Exception;
  803. end if;
  804. end Half_Delay;
  805. procedure Set_Flush_On_Interrupt_Mode
  806. (Win : in Window := Standard_Window;
  807. Mode : in Boolean := True)
  808. is
  809. function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
  810. pragma Import (C, Intrflush, "intrflush");
  811. begin
  812. if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
  813. raise Curses_Exception;
  814. end if;
  815. end Set_Flush_On_Interrupt_Mode;
  816. procedure Set_Queue_Interrupt_Mode
  817. (Win : in Window := Standard_Window;
  818. Flush : in Boolean := True)
  819. is
  820. procedure Qiflush;
  821. pragma Import (C, Qiflush, "qiflush");
  822. procedure No_Qiflush;
  823. pragma Import (C, No_Qiflush, "noqiflush");
  824. begin
  825. if Win = Null_Window then
  826. raise Curses_Exception;
  827. end if;
  828. if Flush then
  829. Qiflush;
  830. else
  831. No_Qiflush;
  832. end if;
  833. end Set_Queue_Interrupt_Mode;
  834. procedure Set_NoDelay_Mode
  835. (Win : in Window := Standard_Window;
  836. Mode : in Boolean := False)
  837. is
  838. function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
  839. pragma Import (C, Nodelay, "nodelay");
  840. begin
  841. if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
  842. raise Curses_Exception;
  843. end if;
  844. end Set_NoDelay_Mode;
  845. procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
  846. Mode : in Timeout_Mode;
  847. Amount : in Natural)
  848. is
  849. procedure Wtimeout (Win : Window; Amount : C_Int);
  850. pragma Import (C, Wtimeout, "wtimeout");
  851. Time : C_Int;
  852. begin
  853. case Mode is
  854. when Blocking => Time := -1;
  855. when Non_Blocking => Time := 0;
  856. when Delayed =>
  857. if Amount = 0 then
  858. raise Constraint_Error;
  859. end if;
  860. Time := C_Int (Amount);
  861. end case;
  862. Wtimeout (Win, Time);
  863. end Set_Timeout_Mode;
  864. procedure Set_Escape_Timer_Mode
  865. (Win : in Window := Standard_Window;
  866. Timer_Off : in Boolean := False)
  867. is
  868. function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
  869. pragma Import (C, Notimeout, "notimeout");
  870. begin
  871. if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
  872. = Curses_Err then
  873. raise Curses_Exception;
  874. end if;
  875. end Set_Escape_Timer_Mode;
  876. ------------------------------------------------------------------------------
  877. procedure Set_NL_Mode (SwitchOn : in Boolean := True)
  878. is
  879. function NL return C_Int;
  880. pragma Import (C, NL, "nl");
  881. function NoNL return C_Int;
  882. pragma Import (C, NoNL, "nonl");
  883. Err : C_Int;
  884. begin
  885. if SwitchOn then
  886. Err := NL;
  887. else
  888. Err := NoNL;
  889. end if;
  890. if Err = Curses_Err then
  891. raise Curses_Exception;
  892. end if;
  893. end Set_NL_Mode;
  894. procedure Clear_On_Next_Update
  895. (Win : in Window := Standard_Window;
  896. Do_Clear : in Boolean := True)
  897. is
  898. function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
  899. pragma Import (C, Clear_Ok, "clearok");
  900. begin
  901. if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
  902. raise Curses_Exception;
  903. end if;
  904. end Clear_On_Next_Update;
  905. procedure Use_Insert_Delete_Line
  906. (Win : in Window := Standard_Window;
  907. Do_Idl : in Boolean := True)
  908. is
  909. function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
  910. pragma Import (C, IDL_Ok, "idlok");
  911. begin
  912. if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
  913. raise Curses_Exception;
  914. end if;
  915. end Use_Insert_Delete_Line;
  916. procedure Use_Insert_Delete_Character
  917. (Win : in Window := Standard_Window;
  918. Do_Idc : in Boolean := True)
  919. is
  920. procedure IDC_Ok (W : Window; Flag : Curses_Bool);
  921. pragma Import (C, IDC_Ok, "idcok");
  922. begin
  923. IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc)));
  924. end Use_Insert_Delete_Character;
  925. procedure Leave_Cursor_After_Update
  926. (Win : in Window := Standard_Window;
  927. Do_Leave : in Boolean := True)
  928. is
  929. function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
  930. pragma Import (C, Leave_Ok, "leaveok");
  931. begin
  932. if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
  933. raise Curses_Exception;
  934. end if;
  935. end Leave_Cursor_After_Update;
  936. procedure Immediate_Update_Mode
  937. (Win : in Window := Standard_Window;
  938. Mode : in Boolean := False)
  939. is
  940. procedure Immedok (Win : Window; Mode : Curses_Bool);
  941. pragma Import (C, Immedok, "immedok");
  942. begin
  943. Immedok (Win, Curses_Bool (Boolean'Pos (Mode)));
  944. end Immediate_Update_Mode;
  945. procedure Allow_Scrolling
  946. (Win : in Window := Standard_Window;
  947. Mode : in Boolean := False)
  948. is
  949. function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
  950. pragma Import (C, Scrollok, "scrollok");
  951. begin
  952. if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
  953. raise Curses_Exception;
  954. end if;
  955. end Allow_Scrolling;
  956. function Scrolling_Allowed (Win : Window := Standard_Window)
  957. return Boolean
  958. is
  959. function Is_Scroll_Ok (W : Window) return Curses_Bool;
  960. pragma Import (C, Is_Scroll_Ok, "is_scrollok");
  961. begin
  962. return (Is_Scroll_Ok (Win) /= Curses_Bool_False);
  963. end Scrolling_Allowed;
  964. procedure Set_Scroll_Region
  965. (Win : in Window := Standard_Window;
  966. Top_Line : in Line_Position;
  967. Bottom_Line : in Line_Position)
  968. is
  969. function Wsetscrreg (Win : Window;
  970. Lin : C_Int;
  971. Col : C_Int) return C_Int;
  972. pragma Import (C, Wsetscrreg, "wsetscrreg");
  973. begin
  974. if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
  975. = Curses_Err then
  976. raise Curses_Exception;
  977. end if;
  978. end Set_Scroll_Region;
  979. ------------------------------------------------------------------------------
  980. procedure Update_Screen
  981. is
  982. function Do_Update return C_Int;
  983. pragma Import (C, Do_Update, "doupdate");
  984. begin
  985. if Do_Update = Curses_Err then
  986. raise Curses_Exception;
  987. end if;
  988. end Update_Screen;
  989. procedure Refresh (Win : in Window := Standard_Window)
  990. is
  991. function Wrefresh (W : Window) return C_Int;
  992. pragma Import (C, Wrefresh, "wrefresh");
  993. begin
  994. if Wrefresh (Win) = Curses_Err then
  995. raise Curses_Exception;
  996. end if;
  997. end Refresh;
  998. procedure Refresh_Without_Update
  999. (Win : in Window := Standard_Window)
  1000. is
  1001. function Wnoutrefresh (W : Window) return C_Int;
  1002. pragma Import (C, Wnoutrefresh, "wnoutrefresh");
  1003. begin
  1004. if Wnoutrefresh (Win) = Curses_Err then
  1005. raise Curses_Exception;
  1006. end if;
  1007. end Refresh_Without_Update;
  1008. procedure Redraw (Win : in Window := Standard_Window)
  1009. is
  1010. function Redrawwin (Win : Window) return C_Int;
  1011. pragma Import (C, Redrawwin, "redrawwin");
  1012. begin
  1013. if Redrawwin (Win) = Curses_Err then
  1014. raise Curses_Exception;
  1015. end if;
  1016. end Redraw;
  1017. procedure Redraw
  1018. (Win : in Window := Standard_Window;
  1019. Begin_Line : in Line_Position;
  1020. Line_Count : in Positive)
  1021. is
  1022. function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
  1023. return C_Int;
  1024. pragma Import (C, Wredrawln, "wredrawln");
  1025. begin
  1026. if Wredrawln (Win,
  1027. C_Int (Begin_Line),
  1028. C_Int (Line_Count)) = Curses_Err then
  1029. raise Curses_Exception;
  1030. end if;
  1031. end Redraw;
  1032. ------------------------------------------------------------------------------
  1033. procedure Erase (Win : in Window := Standard_Window)
  1034. is
  1035. function Werase (W : Window) return C_Int;
  1036. pragma Import (C, Werase, "werase");
  1037. begin
  1038. if Werase (Win) = Curses_Err then
  1039. raise Curses_Exception;
  1040. end if;
  1041. end Erase;
  1042. procedure Clear (Win : in Window := Standard_Window)
  1043. is
  1044. function Wclear (W : Window) return C_Int;
  1045. pragma Import (C, Wclear, "wclear");
  1046. begin
  1047. if Wclear (Win) = Curses_Err then
  1048. raise Curses_Exception;
  1049. end if;
  1050. end Clear;
  1051. procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
  1052. is
  1053. function Wclearbot (W : Window) return C_Int;
  1054. pragma Import (C, Wclearbot, "wclrtobot");
  1055. begin
  1056. if Wclearbot (Win) = Curses_Err then
  1057. raise Curses_Exception;
  1058. end if;
  1059. end Clear_To_End_Of_Screen;
  1060. procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
  1061. is
  1062. function Wcleareol (W : Window) return C_Int;
  1063. pragma Import (C, Wcleareol, "wclrtoeol");
  1064. begin
  1065. if Wcleareol (Win) = Curses_Err then
  1066. raise Curses_Exception;
  1067. end if;
  1068. end Clear_To_End_Of_Line;
  1069. ------------------------------------------------------------------------------
  1070. procedure Set_Background
  1071. (Win : in Window := Standard_Window;
  1072. Ch : in Attributed_Character)
  1073. is
  1074. procedure WBackground (W : in Window; Ch : in C_Chtype);
  1075. pragma Import (C, WBackground, "wbkgdset");
  1076. begin
  1077. WBackground (Win, AttrChar_To_Chtype (Ch));
  1078. end Set_Background;
  1079. procedure Change_Background
  1080. (Win : in Window := Standard_Window;
  1081. Ch : in Attributed_Character)
  1082. is
  1083. function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
  1084. pragma Import (C, WChangeBkgd, "wbkgd");
  1085. begin
  1086. if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
  1087. raise Curses_Exception;
  1088. end if;
  1089. end Change_Background;
  1090. function Get_Background (Win : Window := Standard_Window)
  1091. return Attributed_Character
  1092. is
  1093. function Wgetbkgd (Win : Window) return C_Chtype;
  1094. pragma Import (C, Wgetbkgd, "getbkgd");
  1095. begin
  1096. return Chtype_To_AttrChar (Wgetbkgd (Win));
  1097. end Get_Background;
  1098. ------------------------------------------------------------------------------
  1099. procedure Change_Lines_Status (Win : in Window := Standard_Window;
  1100. Start : in Line_Position;
  1101. Count : in Positive;
  1102. State : in Boolean)
  1103. is
  1104. function Wtouchln (Win : Window;
  1105. Sta : C_Int;
  1106. Cnt : C_Int;
  1107. Chg : C_Int) return C_Int;
  1108. pragma Import (C, Wtouchln, "wtouchln");
  1109. begin
  1110. if Wtouchln (Win, C_Int (Start), C_Int (Count),
  1111. C_Int (Boolean'Pos (State))) = Curses_Err then
  1112. raise Curses_Exception;
  1113. end if;
  1114. end Change_Lines_Status;
  1115. procedure Touch (Win : in Window := Standard_Window)
  1116. is
  1117. Y : Line_Position;
  1118. X : Column_Position;
  1119. begin
  1120. Get_Size (Win, Y, X);
  1121. Change_Lines_Status (Win, 0, Positive (Y), True);
  1122. end Touch;
  1123. procedure Untouch (Win : in Window := Standard_Window)
  1124. is
  1125. Y : Line_Position;
  1126. X : Column_Position;
  1127. begin
  1128. Get_Size (Win, Y, X);
  1129. Change_Lines_Status (Win, 0, Positive (Y), False);
  1130. end Untouch;
  1131. procedure Touch (Win : in Window := Standard_Window;
  1132. Start : in Line_Position;
  1133. Count : in Positive)
  1134. is
  1135. begin
  1136. Change_Lines_Status (Win, Start, Count, True);
  1137. end Touch;
  1138. function Is_Touched
  1139. (Win : Window := Standard_Window;
  1140. Line : Line_Position) return Boolean
  1141. is
  1142. function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
  1143. pragma Import (C, WLineTouched, "is_linetouched");
  1144. begin
  1145. if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
  1146. return False;
  1147. else
  1148. return True;
  1149. end if;
  1150. end Is_Touched;
  1151. function Is_Touched
  1152. (Win : Window := Standard_Window) return Boolean
  1153. is
  1154. function WWinTouched (W : Window) return Curses_Bool;
  1155. pragma Import (C, WWinTouched, "is_wintouched");
  1156. begin
  1157. if WWinTouched (Win) = Curses_Bool_False then
  1158. return False;
  1159. else
  1160. return True;
  1161. end if;
  1162. end Is_Touched;
  1163. ------------------------------------------------------------------------------
  1164. procedure Copy
  1165. (Source_Window : in Window;
  1166. Destination_Window : in Window;
  1167. Source_Top_Row : in Line_Position;
  1168. Source_Left_Column : in Column_Position;
  1169. Destination_Top_Row : in Line_Position;
  1170. Destination_Left_Column : in Column_Position;
  1171. Destination_Bottom_Row : in Line_Position;
  1172. Destination_Right_Column : in Column_Position;
  1173. Non_Destructive_Mode : in Boolean := True)
  1174. is
  1175. function Copywin (Src : Window;
  1176. Dst : Window;
  1177. Str : C_Int;
  1178. Slc : C_Int;
  1179. Dtr : C_Int;
  1180. Dlc : C_Int;
  1181. Dbr : C_Int;
  1182. Drc : C_Int;
  1183. Ndm : C_Int) return C_Int;
  1184. pragma Import (C, Copywin, "copywin");
  1185. begin
  1186. if Copywin (Source_Window,
  1187. Destination_Window,
  1188. C_Int (Source_Top_Row),
  1189. C_Int (Source_Left_Column),
  1190. C_Int (Destination_Top_Row),
  1191. C_Int (Destination_Left_Column),
  1192. C_Int (Destination_Bottom_Row),
  1193. C_Int (Destination_Right_Column),
  1194. Boolean'Pos (Non_Destructive_Mode)
  1195. ) = Curses_Err then
  1196. raise Curses_Exception;
  1197. end if;
  1198. end Copy;
  1199. procedure Overwrite
  1200. (Source_Window : in Window;
  1201. Destination_Window : in Window)
  1202. is
  1203. function Overwrite (Src : Window; Dst : Window) return C_Int;
  1204. pragma Import (C, Overwrite, "overwrite");
  1205. begin
  1206. if Overwrite (Source_Window, Destination_Window) = Curses_Err then
  1207. raise Curses_Exception;
  1208. end if;
  1209. end Overwrite;
  1210. procedure Overlay
  1211. (Source_Window : in Window;
  1212. Destination_Window : in Window)
  1213. is
  1214. function Overlay (Src : Window; Dst : Window) return C_Int;
  1215. pragma Import (C, Overlay, "overlay");
  1216. begin
  1217. if Overlay (Source_Window, Destination_Window) = Curses_Err then
  1218. raise Curses_Exception;
  1219. end if;
  1220. end Overlay;
  1221. ------------------------------------------------------------------------------
  1222. procedure Insert_Delete_Lines
  1223. (Win : in Window := Standard_Window;
  1224. Lines : in Integer := 1) -- default is to insert one line above
  1225. is
  1226. function Winsdelln (W : Window; N : C_Int) return C_Int;
  1227. pragma Import (C, Winsdelln, "winsdelln");
  1228. begin
  1229. if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
  1230. raise Curses_Exception;
  1231. end if;
  1232. end Insert_Delete_Lines;
  1233. procedure Delete_Line (Win : in Window := Standard_Window)
  1234. is
  1235. begin
  1236. Insert_Delete_Lines (Win, -1);
  1237. end Delete_Line;
  1238. procedure Insert_Line (Win : in Window := Standard_Window)
  1239. is
  1240. begin
  1241. Insert_Delete_Lines (Win, 1);
  1242. end Insert_Line;
  1243. ------------------------------------------------------------------------------
  1244. procedure Get_Size
  1245. (Win : in Window := Standard_Window;
  1246. Number_Of_Lines : out Line_Count;
  1247. Number_Of_Columns : out Column_Count)
  1248. is
  1249. function GetMaxY (W : Window) return C_Int;
  1250. pragma Import (C, GetMaxY, "getmaxy");
  1251. function GetMaxX (W : Window) return C_Int;
  1252. pragma Import (C, GetMaxX, "getmaxx");
  1253. Y : constant C_Int := GetMaxY (Win)
  1254. + C_Int (Offset_XY);
  1255. X : constant C_Int := GetMaxX (Win)
  1256. + C_Int (Offset_XY);
  1257. begin
  1258. Number_Of_Lines := Line_Count (Y);
  1259. Number_Of_Columns := Column_Count (X);
  1260. end Get_Size;
  1261. procedure Get_Window_Position
  1262. (Win : in Window := Standard_Window;
  1263. Top_Left_Line : out Line_Position;
  1264. Top_Left_Column : out Column_Position)
  1265. is
  1266. function GetBegY (W : Window) return C_Int;
  1267. pragma Import (C, GetBegY, "getbegy");
  1268. function GetBegX (W : Window) return C_Int;
  1269. pragma Import (C, GetBegX, "getbegx");
  1270. Y : constant C_Short := C_Short (GetBegY (Win));
  1271. X : constant C_Short := C_Short (GetBegX (Win));
  1272. begin
  1273. Top_Left_Line := Line_Position (Y);
  1274. Top_Left_Column := Column_Position (X);
  1275. end Get_Window_Position;
  1276. procedure Get_Cursor_Position
  1277. (Win : in Window := Standard_Window;
  1278. Line : out Line_Position;
  1279. Column : out Column_Position)
  1280. is
  1281. function GetCurY (W : Window) return C_Int;
  1282. pragma Import (C, GetCurY, "getcury");
  1283. function GetCurX (W : Window) return C_Int;
  1284. pragma Import (C, GetCurX, "getcurx");
  1285. Y : constant C_Short := C_Short (GetCurY (Win));
  1286. X : constant C_Short := C_Short (GetCurX (Win));
  1287. begin
  1288. Line := Line_Position (Y);
  1289. Column := Column_Position (X);
  1290. end Get_Cursor_Position;
  1291. procedure Get_Origin_Relative_To_Parent
  1292. (Win : in Window;
  1293. Top_Left_Line : out Line_Position;
  1294. Top_Left_Column : out Column_Position;
  1295. Is_Not_A_Subwindow : out Boolean)
  1296. is
  1297. function GetParY (W : Window) return C_Int;
  1298. pragma Import (C, GetParY, "getpary");
  1299. function GetParX (W : Window) return C_Int;
  1300. pragma Import (C, GetParX, "getparx");
  1301. Y : constant C_Int := GetParY (Win);
  1302. X : constant C_Int := GetParX (Win);
  1303. begin
  1304. if Y = -1 then
  1305. Top_Left_Line := Line_Position'Last;
  1306. Top_Left_Column := Column_Position'Last;
  1307. Is_Not_A_Subwindow := True;
  1308. else
  1309. Top_Left_Line := Line_Position (Y);
  1310. Top_Left_Column := Column_Position (X);
  1311. Is_Not_A_Subwindow := False;
  1312. end if;
  1313. end Get_Origin_Relative_To_Parent;
  1314. ------------------------------------------------------------------------------
  1315. function New_Pad (Lines : Line_Count;
  1316. Columns : Column_Count) return Window
  1317. is
  1318. function Newpad (Lines : C_Int; Columns : C_Int) return Window;
  1319. pragma Import (C, Newpad, "newpad");
  1320. W : Window;
  1321. begin
  1322. W := Newpad (C_Int (Lines), C_Int (Columns));
  1323. if W = Null_Window then
  1324. raise Curses_Exception;
  1325. end if;
  1326. return W;
  1327. end New_Pad;
  1328. function Sub_Pad
  1329. (Pad : Window;
  1330. Number_Of_Lines : Line_Count;
  1331. Number_Of_Columns : Column_Count;
  1332. First_Line_Position : Line_Position;
  1333. First_Column_Position : Column_Position) return Window
  1334. is
  1335. function Subpad
  1336. (Pad : Window;
  1337. Number_Of_Lines : C_Int;
  1338. Number_Of_Columns : C_Int;
  1339. First_Line_Position : C_Int;
  1340. First_Column_Position : C_Int) return Window;
  1341. pragma Import (C, Subpad, "subpad");
  1342. W : Window;
  1343. begin
  1344. W := Subpad (Pad,
  1345. C_Int (Number_Of_Lines),
  1346. C_Int (Number_Of_Columns),
  1347. C_Int (First_Line_Position),
  1348. C_Int (First_Column_Position));
  1349. if W = Null_Window then
  1350. raise Curses_Exception;
  1351. end if;
  1352. return W;
  1353. end Sub_Pad;
  1354. procedure Refresh
  1355. (Pad : in Window;
  1356. Source_Top_Row : in Line_Position;
  1357. Source_Left_Column : in Column_Position;
  1358. Destination_Top_Row : in Line_Position;
  1359. Destination_Left_Column : in Column_Position;
  1360. Destination_Bottom_Row : in Line_Position;
  1361. Destination_Right_Column : in Column_Position)
  1362. is
  1363. function Prefresh
  1364. (Pad : Window;
  1365. Source_Top_Row : C_Int;
  1366. Source_Left_Column : C_Int;
  1367. Destination_Top_Row : C_Int;
  1368. Destination_Left_Column : C_Int;
  1369. Destination_Bottom_Row : C_Int;
  1370. Destination_Right_Column : C_Int) return C_Int;
  1371. pragma Import (C, Prefresh, "prefresh");
  1372. begin
  1373. if Prefresh (Pad,
  1374. C_Int (Source_Top_Row),
  1375. C_Int (Source_Left_Column),
  1376. C_Int (Destination_Top_Row),
  1377. C_Int (Destination_Left_Column),
  1378. C_Int (Destination_Bottom_Row),
  1379. C_Int (Destination_Right_Column)) = Curses_Err then
  1380. raise Curses_Exception;
  1381. end if;
  1382. end Refresh;
  1383. procedure Refresh_Without_Update
  1384. (Pad : in Window;
  1385. Source_Top_Row : in Line_Position;
  1386. Source_Left_Column : in Column_Position;
  1387. Destination_Top_Row : in Line_Position;
  1388. Destination_Left_Column : in Column_Position;
  1389. Destination_Bottom_Row : in Line_Position;
  1390. Destination_Right_Column : in Column_Position)
  1391. is
  1392. function Pnoutrefresh
  1393. (Pad : Window;
  1394. Source_Top_Row : C_Int;
  1395. Source_Left_Column : C_Int;
  1396. Destination_Top_Row : C_Int;
  1397. Destination_Left_Column : C_Int;
  1398. Destination_Bottom_Row : C_Int;
  1399. Destination_Right_Column : C_Int) return C_Int;
  1400. pragma Import (C, Pnoutrefresh, "pnoutrefresh");
  1401. begin
  1402. if Pnoutrefresh (Pad,
  1403. C_Int (Source_Top_Row),
  1404. C_Int (Source_Left_Column),
  1405. C_Int (Destination_Top_Row),
  1406. C_Int (Destination_Left_Column),
  1407. C_Int (Destination_Bottom_Row),
  1408. C_Int (Destination_Right_Column)) = Curses_Err then
  1409. raise Curses_Exception;
  1410. end if;
  1411. end Refresh_Without_Update;
  1412. procedure Add_Character_To_Pad_And_Echo_It
  1413. (Pad : in Window;
  1414. Ch : in Attributed_Character)
  1415. is
  1416. function Pechochar (Pad : Window; Ch : C_Chtype)
  1417. return C_Int;
  1418. pragma Import (C, Pechochar, "pechochar");
  1419. begin
  1420. if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
  1421. raise Curses_Exception;
  1422. end if;
  1423. end Add_Character_To_Pad_And_Echo_It;
  1424. procedure Add_Character_To_Pad_And_Echo_It
  1425. (Pad : in Window;
  1426. Ch : in Character)
  1427. is
  1428. begin
  1429. Add_Character_To_Pad_And_Echo_It
  1430. (Pad,
  1431. Attributed_Character'(Ch => Ch,
  1432. Color => Color_Pair'First,
  1433. Attr => Normal_Video));
  1434. end Add_Character_To_Pad_And_Echo_It;
  1435. ------------------------------------------------------------------------------
  1436. procedure Scroll (Win : in Window := Standard_Window;
  1437. Amount : in Integer := 1)
  1438. is
  1439. function Wscrl (Win : Window; N : C_Int) return C_Int;
  1440. pragma Import (C, Wscrl, "wscrl");
  1441. begin
  1442. if Wscrl (Win, C_Int (Amount)) = Curses_Err then
  1443. raise Curses_Exception;
  1444. end if;
  1445. end Scroll;
  1446. ------------------------------------------------------------------------------
  1447. procedure Delete_Character (Win : in Window := Standard_Window)
  1448. is
  1449. function Wdelch (Win : Window) return C_Int;
  1450. pragma Import (C, Wdelch, "wdelch");
  1451. begin
  1452. if Wdelch (Win) = Curses_Err then
  1453. raise Curses_Exception;
  1454. end if;
  1455. end Delete_Character;
  1456. procedure Delete_Character
  1457. (Win : in Window := Standard_Window;
  1458. Line : in Line_Position;
  1459. Column : in Column_Position)
  1460. is
  1461. function Mvwdelch (Win : Window;
  1462. Lin : C_Int;
  1463. Col : C_Int) return C_Int;
  1464. pragma Import (C, Mvwdelch, "mvwdelch");
  1465. begin
  1466. if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
  1467. raise Curses_Exception;
  1468. end if;
  1469. end Delete_Character;
  1470. ------------------------------------------------------------------------------
  1471. function Peek (Win : Window := Standard_Window)
  1472. return Attributed_Character
  1473. is
  1474. function Winch (Win : Window) return C_Chtype;
  1475. pragma Import (C, Winch, "winch");
  1476. begin
  1477. return Chtype_To_AttrChar (Winch (Win));
  1478. end Peek;
  1479. function Peek
  1480. (Win : Window := Standard_Window;
  1481. Line : Line_Position;
  1482. Column : Column_Position) return Attributed_Character
  1483. is
  1484. function Mvwinch (Win : Window;
  1485. Lin : C_Int;
  1486. Col : C_Int) return C_Chtype;
  1487. pragma Import (C, Mvwinch, "mvwinch");
  1488. begin
  1489. return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
  1490. end Peek;
  1491. ------------------------------------------------------------------------------
  1492. procedure Insert (Win : in Window := Standard_Window;
  1493. Ch : in Attributed_Character)
  1494. is
  1495. function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
  1496. pragma Import (C, Winsch, "winsch");
  1497. begin
  1498. if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
  1499. raise Curses_Exception;
  1500. end if;
  1501. end Insert;
  1502. procedure Insert
  1503. (Win : in Window := Standard_Window;
  1504. Line : in Line_Position;
  1505. Column : in Column_Position;
  1506. Ch : in Attributed_Character)
  1507. is
  1508. function Mvwinsch (Win : Window;
  1509. Lin : C_Int;
  1510. Col : C_Int;
  1511. Ch : C_Chtype) return C_Int;
  1512. pragma Import (C, Mvwinsch, "mvwinsch");
  1513. begin
  1514. if Mvwinsch (Win,
  1515. C_Int (Line),
  1516. C_Int (Column),
  1517. AttrChar_To_Chtype (Ch)) = Curses_Err then
  1518. raise Curses_Exception;
  1519. end if;
  1520. end Insert;
  1521. ------------------------------------------------------------------------------
  1522. procedure Insert (Win : in Window := Standard_Window;
  1523. Str : in String;
  1524. Len : in Integer := -1)
  1525. is
  1526. function Winsnstr (Win : Window;
  1527. Str : char_array;
  1528. Len : Integer := -1) return C_Int;
  1529. pragma Import (C, Winsnstr, "winsnstr");
  1530. Txt : char_array (0 .. Str'Length);
  1531. Length : size_t;
  1532. begin
  1533. To_C (Str, Txt, Length);
  1534. if Winsnstr (Win, Txt, Len) = Curses_Err then
  1535. raise Curses_Exception;
  1536. end if;
  1537. end Insert;
  1538. procedure Insert
  1539. (Win : in Window := Standard_Window;
  1540. Line : in Line_Position;
  1541. Column : in Column_Position;
  1542. Str : in String;
  1543. Len : in Integer := -1)
  1544. is
  1545. function Mvwinsnstr (Win : Window;
  1546. Line : C_Int;
  1547. Column : C_Int;
  1548. Str : char_array;
  1549. Len : C_Int) return C_Int;
  1550. pragma Import (C, Mvwinsnstr, "mvwinsnstr");
  1551. Txt : char_array (0 .. Str'Length);
  1552. Length : size_t;
  1553. begin
  1554. To_C (Str, Txt, Length);
  1555. if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
  1556. = Curses_Err then
  1557. raise Curses_Exception;
  1558. end if;
  1559. end Insert;
  1560. ------------------------------------------------------------------------------
  1561. procedure Peek (Win : in Window := Standard_Window;
  1562. Str : out String;
  1563. Len : in Integer := -1)
  1564. is
  1565. function Winnstr (Win : Window;
  1566. Str : char_array;
  1567. Len : C_Int) return C_Int;
  1568. pragma Import (C, Winnstr, "winnstr");
  1569. N : Integer := Len;
  1570. Txt : char_array (0 .. Str'Length);
  1571. Cnt : Natural;
  1572. begin
  1573. if N < 0 then
  1574. N := Str'Length;
  1575. end if;
  1576. if N > Str'Length then
  1577. raise Constraint_Error;
  1578. end if;
  1579. Txt (0) := Interfaces.C.char'First;
  1580. if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
  1581. raise Curses_Exception;
  1582. end if;
  1583. To_Ada (Txt, Str, Cnt, True);
  1584. if Cnt < Str'Length then
  1585. Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
  1586. end if;
  1587. end Peek;
  1588. procedure Peek
  1589. (Win : in Window := Standard_Window;
  1590. Line : in Line_Position;
  1591. Column : in Column_Position;
  1592. Str : out String;
  1593. Len : in Integer := -1)
  1594. is
  1595. begin
  1596. Move_Cursor (Win, Line, Column);
  1597. Peek (Win, Str, Len);
  1598. end Peek;
  1599. ------------------------------------------------------------------------------
  1600. procedure Peek
  1601. (Win : in Window := Standard_Window;
  1602. Str : out Attributed_String;
  1603. Len : in Integer := -1)
  1604. is
  1605. function Winchnstr (Win : Window;
  1606. Str : chtype_array; -- out
  1607. Len : C_Int) return C_Int;
  1608. pragma Import (C, Winchnstr, "winchnstr");
  1609. N : Integer := Len;
  1610. Txt : constant chtype_array (0 .. Str'Length)
  1611. := (0 => Default_Character);
  1612. Cnt : Natural := 0;
  1613. begin
  1614. if N < 0 then
  1615. N := Str'Length;
  1616. end if;
  1617. if N > Str'Length then
  1618. raise Constraint_Error;
  1619. end if;
  1620. if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
  1621. raise Curses_Exception;
  1622. end if;
  1623. for To in Str'Range loop
  1624. exit when Txt (size_t (Cnt)) = Default_Character;
  1625. Str (To) := Txt (size_t (Cnt));
  1626. Cnt := Cnt + 1;
  1627. end loop;
  1628. if Cnt < Str'Length then
  1629. Str ((Str'First + Cnt) .. Str'Last) :=
  1630. (others => (Ch => ' ',
  1631. Color => Color_Pair'First,
  1632. Attr => Normal_Video));
  1633. end if;
  1634. end Peek;
  1635. procedure Peek
  1636. (Win : in Window := Standard_Window;
  1637. Line : in Line_Position;
  1638. Column : in Column_Position;
  1639. Str : out Attributed_String;
  1640. Len : in Integer := -1)
  1641. is
  1642. begin
  1643. Move_Cursor (Win, Line, Column);
  1644. Peek (Win, Str, Len);
  1645. end Peek;
  1646. ------------------------------------------------------------------------------
  1647. procedure Get (Win : in Window := Standard_Window;
  1648. Str : out String;
  1649. Len : in Integer := -1)
  1650. is
  1651. function Wgetnstr (Win : Window;
  1652. Str : char_array;
  1653. Len : C_Int) return C_Int;
  1654. pragma Import (C, Wgetnstr, "wgetnstr");
  1655. N : Integer := Len;
  1656. Txt : char_array (0 .. Str'Length);
  1657. Cnt : Natural;
  1658. begin
  1659. if N < 0 then
  1660. N := Str'Length;
  1661. end if;
  1662. if N > Str'Length then
  1663. raise Constraint_Error;
  1664. end if;
  1665. Txt (0) := Interfaces.C.char'First;
  1666. if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
  1667. raise Curses_Exception;
  1668. end if;
  1669. To_Ada (Txt, Str, Cnt, True);
  1670. if Cnt < Str'Length then
  1671. Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
  1672. end if;
  1673. end Get;
  1674. procedure Get
  1675. (Win : in Window := Standard_Window;
  1676. Line : in Line_Position;
  1677. Column : in Column_Position;
  1678. Str : out String;
  1679. Len : in Integer := -1)
  1680. is
  1681. begin
  1682. Move_Cursor (Win, Line, Column);
  1683. Get (Win, Str, Len);
  1684. end Get;
  1685. ------------------------------------------------------------------------------
  1686. procedure Init_Soft_Label_Keys
  1687. (Format : in Soft_Label_Key_Format := Three_Two_Three)
  1688. is
  1689. function Slk_Init (Fmt : C_Int) return C_Int;
  1690. pragma Import (C, Slk_Init, "slk_init");
  1691. begin
  1692. if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
  1693. raise Curses_Exception;
  1694. end if;
  1695. end Init_Soft_Label_Keys;
  1696. procedure Set_Soft_Label_Key (Label : in Label_Number;
  1697. Text : in String;
  1698. Fmt : in Label_Justification := Left)
  1699. is
  1700. function Slk_Set (Label : C_Int;
  1701. Txt : char_array;
  1702. Fmt : C_Int) return C_Int;
  1703. pragma Import (C, Slk_Set, "slk_set");
  1704. Txt : char_array (0 .. Text'Length);
  1705. Len : size_t;
  1706. begin
  1707. To_C (Text, Txt, Len);
  1708. if Slk_Set (C_Int (Label), Txt,
  1709. C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
  1710. raise Curses_Exception;
  1711. end if;
  1712. end Set_Soft_Label_Key;
  1713. procedure Refresh_Soft_Label_Keys
  1714. is
  1715. function Slk_Refresh return C_Int;
  1716. pragma Import (C, Slk_Refresh, "slk_refresh");
  1717. begin
  1718. if Slk_Refresh = Curses_Err then
  1719. raise Curses_Exception;
  1720. end if;
  1721. end Refresh_Soft_Label_Keys;
  1722. procedure Refresh_Soft_Label_Keys_Without_Update
  1723. is
  1724. function Slk_Noutrefresh return C_Int;
  1725. pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
  1726. begin
  1727. if Slk_Noutrefresh = Curses_Err then
  1728. raise Curses_Exception;
  1729. end if;
  1730. end Refresh_Soft_Label_Keys_Without_Update;
  1731. procedure Get_Soft_Label_Key (Label : in Label_Number;
  1732. Text : out String)
  1733. is
  1734. function Slk_Label (Label : C_Int) return chars_ptr;
  1735. pragma Import (C, Slk_Label, "slk_label");
  1736. begin
  1737. Fill_String (Slk_Label (C_Int (Label)), Text);
  1738. end Get_Soft_Label_Key;
  1739. function Get_Soft_Label_Key (Label : in Label_Number) return String
  1740. is
  1741. function Slk_Label (Label : C_Int) return chars_ptr;
  1742. pragma Import (C, Slk_Label, "slk_label");
  1743. begin
  1744. return Fill_String (Slk_Label (C_Int (Label)));
  1745. end Get_Soft_Label_Key;
  1746. procedure Clear_Soft_Label_Keys
  1747. is
  1748. function Slk_Clear return C_Int;
  1749. pragma Import (C, Slk_Clear, "slk_clear");
  1750. begin
  1751. if Slk_Clear = Curses_Err then
  1752. raise Curses_Exception;
  1753. end if;
  1754. end Clear_Soft_Label_Keys;
  1755. procedure Restore_Soft_Label_Keys
  1756. is
  1757. function Slk_Restore return C_Int;
  1758. pragma Import (C, Slk_Restore, "slk_restore");
  1759. begin
  1760. if Slk_Restore = Curses_Err then
  1761. raise Curses_Exception;
  1762. end if;
  1763. end Restore_Soft_Label_Keys;
  1764. procedure Touch_Soft_Label_Keys
  1765. is
  1766. function Slk_Touch return C_Int;
  1767. pragma Import (C, Slk_Touch, "slk_touch");
  1768. begin
  1769. if Slk_Touch = Curses_Err then
  1770. raise Curses_Exception;
  1771. end if;
  1772. end Touch_Soft_Label_Keys;
  1773. procedure Switch_Soft_Label_Key_Attributes
  1774. (Attr : in Character_Attribute_Set;
  1775. On : in Boolean := True)
  1776. is
  1777. function Slk_Attron (Ch : C_Chtype) return C_Int;
  1778. pragma Import (C, Slk_Attron, "slk_attron");
  1779. function Slk_Attroff (Ch : C_Chtype) return C_Int;
  1780. pragma Import (C, Slk_Attroff, "slk_attroff");
  1781. Err : C_Int;
  1782. Ch : constant Attributed_Character := (Ch => Character'First,
  1783. Attr => Attr,
  1784. Color => Color_Pair'First);
  1785. begin
  1786. if On then
  1787. Err := Slk_Attron (AttrChar_To_Chtype (Ch));
  1788. else
  1789. Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
  1790. end if;
  1791. if Err = Curses_Err then
  1792. raise Curses_Exception;
  1793. end if;
  1794. end Switch_Soft_Label_Key_Attributes;
  1795. procedure Set_Soft_Label_Key_Attributes
  1796. (Attr : in Character_Attribute_Set := Normal_Video;
  1797. Color : in Color_Pair := Color_Pair'First)
  1798. is
  1799. function Slk_Attrset (Ch : C_Chtype) return C_Int;
  1800. pragma Import (C, Slk_Attrset, "slk_attrset");
  1801. Ch : constant Attributed_Character := (Ch => Character'First,
  1802. Attr => Attr,
  1803. Color => Color);
  1804. begin
  1805. if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
  1806. raise Curses_Exception;
  1807. end if;
  1808. end Set_Soft_Label_Key_Attributes;
  1809. function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
  1810. is
  1811. function Slk_Attr return C_Chtype;
  1812. pragma Import (C, Slk_Attr, "slk_attr");
  1813. Attr : constant C_Chtype := Slk_Attr;
  1814. begin
  1815. return Chtype_To_AttrChar (Attr).Attr;
  1816. end Get_Soft_Label_Key_Attributes;
  1817. function Get_Soft_Label_Key_Attributes return Color_Pair
  1818. is
  1819. function Slk_Attr return C_Chtype;
  1820. pragma Import (C, Slk_Attr, "slk_attr");
  1821. Attr : constant C_Chtype := Slk_Attr;
  1822. begin
  1823. return Chtype_To_AttrChar (Attr).Color;
  1824. end Get_Soft_Label_Key_Attributes;
  1825. procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
  1826. is
  1827. function Slk_Color (Color : in C_Short) return C_Int;
  1828. pragma Import (C, Slk_Color, "slk_color");
  1829. begin
  1830. if Slk_Color (C_Short (Pair)) = Curses_Err then
  1831. raise Curses_Exception;
  1832. end if;
  1833. end Set_Soft_Label_Key_Color;
  1834. ------------------------------------------------------------------------------
  1835. procedure Enable_Key (Key : in Special_Key_Code;
  1836. Enable : in Boolean := True)
  1837. is
  1838. function Keyok (Keycode : C_Int;
  1839. On_Off : Curses_Bool) return C_Int;
  1840. pragma Import (C, Keyok, "keyok");
  1841. begin
  1842. if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
  1843. = Curses_Err then
  1844. raise Curses_Exception;
  1845. end if;
  1846. end Enable_Key;
  1847. ------------------------------------------------------------------------------
  1848. procedure Define_Key (Definition : in String;
  1849. Key : in Special_Key_Code)
  1850. is
  1851. function Defkey (Def : char_array;
  1852. Key : C_Int) return C_Int;
  1853. pragma Import (C, Defkey, "define_key");
  1854. Txt : char_array (0 .. Definition'Length);
  1855. Length : size_t;
  1856. begin
  1857. To_C (Definition, Txt, Length);
  1858. if Defkey (Txt, C_Int (Key)) = Curses_Err then
  1859. raise Curses_Exception;
  1860. end if;
  1861. end Define_Key;
  1862. ------------------------------------------------------------------------------
  1863. procedure Un_Control (Ch : in Attributed_Character;
  1864. Str : out String)
  1865. is
  1866. function Unctrl (Ch : C_Chtype) return chars_ptr;
  1867. pragma Import (C, Unctrl, "unctrl");
  1868. begin
  1869. Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
  1870. end Un_Control;
  1871. function Un_Control (Ch : in Attributed_Character) return String
  1872. is
  1873. function Unctrl (Ch : C_Chtype) return chars_ptr;
  1874. pragma Import (C, Unctrl, "unctrl");
  1875. begin
  1876. return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
  1877. end Un_Control;
  1878. procedure Delay_Output (Msecs : in Natural)
  1879. is
  1880. function Delayoutput (Msecs : C_Int) return C_Int;
  1881. pragma Import (C, Delayoutput, "delay_output");
  1882. begin
  1883. if Delayoutput (C_Int (Msecs)) = Curses_Err then
  1884. raise Curses_Exception;
  1885. end if;
  1886. end Delay_Output;
  1887. procedure Flush_Input
  1888. is
  1889. function Flushinp return C_Int;
  1890. pragma Import (C, Flushinp, "flushinp");
  1891. begin
  1892. if Flushinp = Curses_Err then -- docu says that never happens, but...
  1893. raise Curses_Exception;
  1894. end if;
  1895. end Flush_Input;
  1896. ------------------------------------------------------------------------------
  1897. function Baudrate return Natural
  1898. is
  1899. function Baud return C_Int;
  1900. pragma Import (C, Baud, "baudrate");
  1901. begin
  1902. return Natural (Baud);
  1903. end Baudrate;
  1904. function Erase_Character return Character
  1905. is
  1906. function Erasechar return C_Int;
  1907. pragma Import (C, Erasechar, "erasechar");
  1908. begin
  1909. return Character'Val (Erasechar);
  1910. end Erase_Character;
  1911. function Kill_Character return Character
  1912. is
  1913. function Killchar return C_Int;
  1914. pragma Import (C, Killchar, "killchar");
  1915. begin
  1916. return Character'Val (Killchar);
  1917. end Kill_Character;
  1918. function Has_Insert_Character return Boolean
  1919. is
  1920. function Has_Ic return Curses_Bool;
  1921. pragma Import (C, Has_Ic, "has_ic");
  1922. begin
  1923. if Has_Ic = Curses_Bool_False then
  1924. return False;
  1925. else
  1926. return True;
  1927. end if;
  1928. end Has_Insert_Character;
  1929. function Has_Insert_Line return Boolean
  1930. is
  1931. function Has_Il return Curses_Bool;
  1932. pragma Import (C, Has_Il, "has_il");
  1933. begin
  1934. if Has_Il = Curses_Bool_False then
  1935. return False;
  1936. else
  1937. return True;
  1938. end if;
  1939. end Has_Insert_Line;
  1940. function Supported_Attributes return Character_Attribute_Set
  1941. is
  1942. function Termattrs return C_Chtype;
  1943. pragma Import (C, Termattrs, "termattrs");
  1944. Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
  1945. begin
  1946. return Ch.Attr;
  1947. end Supported_Attributes;
  1948. procedure Long_Name (Name : out String)
  1949. is
  1950. function Longname return chars_ptr;
  1951. pragma Import (C, Longname, "longname");
  1952. begin
  1953. Fill_String (Longname, Name);
  1954. end Long_Name;
  1955. function Long_Name return String
  1956. is
  1957. function Longname return chars_ptr;
  1958. pragma Import (C, Longname, "longname");
  1959. begin
  1960. return Fill_String (Longname);
  1961. end Long_Name;
  1962. procedure Terminal_Name (Name : out String)
  1963. is
  1964. function Termname return chars_ptr;
  1965. pragma Import (C, Termname, "termname");
  1966. begin
  1967. Fill_String (Termname, Name);
  1968. end Terminal_Name;
  1969. function Terminal_Name return String
  1970. is
  1971. function Termname return chars_ptr;
  1972. pragma Import (C, Termname, "termname");
  1973. begin
  1974. return Fill_String (Termname);
  1975. end Terminal_Name;
  1976. ------------------------------------------------------------------------------
  1977. procedure Init_Pair (Pair : in Redefinable_Color_Pair;
  1978. Fore : in Color_Number;
  1979. Back : in Color_Number)
  1980. is
  1981. function Initpair (Pair : C_Short;
  1982. Fore : C_Short;
  1983. Back : C_Short) return C_Int;
  1984. pragma Import (C, Initpair, "init_pair");
  1985. begin
  1986. if Integer (Pair) >= Number_Of_Color_Pairs then
  1987. raise Constraint_Error;
  1988. end if;
  1989. if Integer (Fore) >= Number_Of_Colors or else
  1990. Integer (Back) >= Number_Of_Colors then
  1991. raise Constraint_Error;
  1992. end if;
  1993. if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
  1994. = Curses_Err then
  1995. raise Curses_Exception;
  1996. end if;
  1997. end Init_Pair;
  1998. procedure Pair_Content (Pair : in Color_Pair;
  1999. Fore : out Color_Number;
  2000. Back : out Color_Number)
  2001. is
  2002. type C_Short_Access is access all C_Short;
  2003. function Paircontent (Pair : C_Short;
  2004. Fp : C_Short_Access;
  2005. Bp : C_Short_Access) return C_Int;
  2006. pragma Import (C, Paircontent, "pair_content");
  2007. F, B : aliased C_Short;
  2008. begin
  2009. if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
  2010. raise Curses_Exception;
  2011. else
  2012. Fore := Color_Number (F);
  2013. Back := Color_Number (B);
  2014. end if;
  2015. end Pair_Content;
  2016. function Has_Colors return Boolean
  2017. is
  2018. function Hascolors return Curses_Bool;
  2019. pragma Import (C, Hascolors, "has_colors");
  2020. begin
  2021. if Hascolors = Curses_Bool_False then
  2022. return False;
  2023. else
  2024. return True;
  2025. end if;
  2026. end Has_Colors;
  2027. procedure Init_Color (Color : in Color_Number;
  2028. Red : in RGB_Value;
  2029. Green : in RGB_Value;
  2030. Blue : in RGB_Value)
  2031. is
  2032. function Initcolor (Col : C_Short;
  2033. Red : C_Short;
  2034. Green : C_Short;
  2035. Blue : C_Short) return C_Int;
  2036. pragma Import (C, Initcolor, "init_color");
  2037. begin
  2038. if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
  2039. C_Short (Blue)) = Curses_Err then
  2040. raise Curses_Exception;
  2041. end if;
  2042. end Init_Color;
  2043. function Can_Change_Color return Boolean
  2044. is
  2045. function Canchangecolor return Curses_Bool;
  2046. pragma Import (C, Canchangecolor, "can_change_color");
  2047. begin
  2048. if Canchangecolor = Curses_Bool_False then
  2049. return False;
  2050. else
  2051. return True;
  2052. end if;
  2053. end Can_Change_Color;
  2054. procedure Color_Content (Color : in Color_Number;
  2055. Red : out RGB_Value;
  2056. Green : out RGB_Value;
  2057. Blue : out RGB_Value)
  2058. is
  2059. type C_Short_Access is access all C_Short;
  2060. function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
  2061. return C_Int;
  2062. pragma Import (C, Colorcontent, "color_content");
  2063. R, G, B : aliased C_Short;
  2064. begin
  2065. if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
  2066. Curses_Err then
  2067. raise Curses_Exception;
  2068. else
  2069. Red := RGB_Value (R);
  2070. Green := RGB_Value (G);
  2071. Blue := RGB_Value (B);
  2072. end if;
  2073. end Color_Content;
  2074. ------------------------------------------------------------------------------
  2075. procedure Save_Curses_Mode (Mode : in Curses_Mode)
  2076. is
  2077. function Def_Prog_Mode return C_Int;
  2078. pragma Import (C, Def_Prog_Mode, "def_prog_mode");
  2079. function Def_Shell_Mode return C_Int;
  2080. pragma Import (C, Def_Shell_Mode, "def_shell_mode");
  2081. Err : C_Int;
  2082. begin
  2083. case Mode is
  2084. when Curses => Err := Def_Prog_Mode;
  2085. when Shell => Err := Def_Shell_Mode;
  2086. end case;
  2087. if Err = Curses_Err then
  2088. raise Curses_Exception;
  2089. end if;
  2090. end Save_Curses_Mode;
  2091. procedure Reset_Curses_Mode (Mode : in Curses_Mode)
  2092. is
  2093. function Reset_Prog_Mode return C_Int;
  2094. pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
  2095. function Reset_Shell_Mode return C_Int;
  2096. pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
  2097. Err : C_Int;
  2098. begin
  2099. case Mode is
  2100. when Curses => Err := Reset_Prog_Mode;
  2101. when Shell => Err := Reset_Shell_Mode;
  2102. end case;
  2103. if Err = Curses_Err then
  2104. raise Curses_Exception;
  2105. end if;
  2106. end Reset_Curses_Mode;
  2107. procedure Save_Terminal_State
  2108. is
  2109. function Savetty return C_Int;
  2110. pragma Import (C, Savetty, "savetty");
  2111. begin
  2112. if Savetty = Curses_Err then
  2113. raise Curses_Exception;
  2114. end if;
  2115. end Save_Terminal_State;
  2116. procedure Reset_Terminal_State
  2117. is
  2118. function Resetty return C_Int;
  2119. pragma Import (C, Resetty, "resetty");
  2120. begin
  2121. if Resetty = Curses_Err then
  2122. raise Curses_Exception;
  2123. end if;
  2124. end Reset_Terminal_State;
  2125. procedure Rip_Off_Lines (Lines : in Integer;
  2126. Proc : in Stdscr_Init_Proc)
  2127. is
  2128. function Ripoffline (Lines : C_Int;
  2129. Proc : Stdscr_Init_Proc) return C_Int;
  2130. pragma Import (C, Ripoffline, "_nc_ripoffline");
  2131. begin
  2132. if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
  2133. raise Curses_Exception;
  2134. end if;
  2135. end Rip_Off_Lines;
  2136. procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
  2137. is
  2138. function Curs_Set (Curs : C_Int) return C_Int;
  2139. pragma Import (C, Curs_Set, "curs_set");
  2140. Res : C_Int;
  2141. begin
  2142. Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
  2143. if Res /= Curses_Err then
  2144. Visibility := Cursor_Visibility'Val (Res);
  2145. end if;
  2146. end Set_Cursor_Visibility;
  2147. procedure Nap_Milli_Seconds (Ms : in Natural)
  2148. is
  2149. function Napms (Ms : C_Int) return C_Int;
  2150. pragma Import (C, Napms, "napms");
  2151. begin
  2152. if Napms (C_Int (Ms)) = Curses_Err then
  2153. raise Curses_Exception;
  2154. end if;
  2155. end Nap_Milli_Seconds;
  2156. ------------------------------------------------------------------------------
  2157. include(`Public_Variables')
  2158. ------------------------------------------------------------------------------
  2159. procedure Transform_Coordinates
  2160. (W : in Window := Standard_Window;
  2161. Line : in out Line_Position;
  2162. Column : in out Column_Position;
  2163. Dir : in Transform_Direction := From_Screen)
  2164. is
  2165. type Int_Access is access all C_Int;
  2166. function Transform (W : Window;
  2167. Y, X : Int_Access;
  2168. Dir : Curses_Bool) return C_Int;
  2169. pragma Import (C, Transform, "wmouse_trafo");
  2170. X : aliased C_Int := C_Int (Column);
  2171. Y : aliased C_Int := C_Int (Line);
  2172. D : Curses_Bool := Curses_Bool_False;
  2173. R : C_Int;
  2174. begin
  2175. if Dir = To_Screen then
  2176. D := 1;
  2177. end if;
  2178. R := Transform (W, Y'Access, X'Access, D);
  2179. if R = Curses_False then
  2180. raise Curses_Exception;
  2181. else
  2182. Line := Line_Position (Y);
  2183. Column := Column_Position (X);
  2184. end if;
  2185. end Transform_Coordinates;
  2186. ------------------------------------------------------------------------------
  2187. procedure Use_Default_Colors is
  2188. function C_Use_Default_Colors return C_Int;
  2189. pragma Import (C, C_Use_Default_Colors, "use_default_colors");
  2190. Err : constant C_Int := C_Use_Default_Colors;
  2191. begin
  2192. if Err = Curses_Err then
  2193. raise Curses_Exception;
  2194. end if;
  2195. end Use_Default_Colors;
  2196. procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
  2197. Back : Color_Number := Default_Color)
  2198. is
  2199. function C_Assume_Default_Colors (Fore : C_Int;
  2200. Back : C_Int) return C_Int;
  2201. pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
  2202. Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
  2203. C_Int (Back));
  2204. begin
  2205. if Err = Curses_Err then
  2206. raise Curses_Exception;
  2207. end if;
  2208. end Assume_Default_Colors;
  2209. ------------------------------------------------------------------------------
  2210. function Curses_Version return String
  2211. is
  2212. function curses_versionC return chars_ptr;
  2213. pragma Import (C, curses_versionC, "curses_version");
  2214. Result : constant chars_ptr := curses_versionC;
  2215. begin
  2216. return Fill_String (Result);
  2217. end Curses_Version;
  2218. ------------------------------------------------------------------------------
  2219. procedure Curses_Free_All is
  2220. procedure curses_freeall;
  2221. pragma Import (C, curses_freeall, "_nc_freeall");
  2222. begin
  2223. -- Use this only for testing: you cannot use curses after calling it,
  2224. -- so it has to be the "last" thing done before exiting the program.
  2225. -- This will not really free ALL of memory used by curses. That is
  2226. -- because it cannot free the memory used for stdout's setbuf. The
  2227. -- _nc_free_and_exit() procedure can do that, but it can be invoked
  2228. -- safely only from C - and again, that only as the "last" thing done
  2229. -- before exiting the program.
  2230. curses_freeall;
  2231. end Curses_Free_All;
  2232. ------------------------------------------------------------------------------
  2233. function Use_Extended_Names (Enable : Boolean) return Boolean
  2234. is
  2235. function use_extended_namesC (e : Curses_Bool) return C_Int;
  2236. pragma Import (C, use_extended_namesC, "use_extended_names");
  2237. Res : constant C_Int :=
  2238. use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
  2239. begin
  2240. if Res = C_Int (Curses_Bool_False) then
  2241. return False;
  2242. else
  2243. return True;
  2244. end if;
  2245. end Use_Extended_Names;
  2246. ------------------------------------------------------------------------------
  2247. procedure Screen_Dump_To_File (Filename : in String)
  2248. is
  2249. function scr_dump (f : char_array) return C_Int;
  2250. pragma Import (C, scr_dump, "scr_dump");
  2251. Txt : char_array (0 .. Filename'Length);
  2252. Length : size_t;
  2253. begin
  2254. To_C (Filename, Txt, Length);
  2255. if Curses_Err = scr_dump (Txt) then
  2256. raise Curses_Exception;
  2257. end if;
  2258. end Screen_Dump_To_File;
  2259. procedure Screen_Restore_From_File (Filename : in String)
  2260. is
  2261. function scr_restore (f : char_array) return C_Int;
  2262. pragma Import (C, scr_restore, "scr_restore");
  2263. Txt : char_array (0 .. Filename'Length);
  2264. Length : size_t;
  2265. begin
  2266. To_C (Filename, Txt, Length);
  2267. if Curses_Err = scr_restore (Txt) then
  2268. raise Curses_Exception;
  2269. end if;
  2270. end Screen_Restore_From_File;
  2271. procedure Screen_Init_From_File (Filename : in String)
  2272. is
  2273. function scr_init (f : char_array) return C_Int;
  2274. pragma Import (C, scr_init, "scr_init");
  2275. Txt : char_array (0 .. Filename'Length);
  2276. Length : size_t;
  2277. begin
  2278. To_C (Filename, Txt, Length);
  2279. if Curses_Err = scr_init (Txt) then
  2280. raise Curses_Exception;
  2281. end if;
  2282. end Screen_Init_From_File;
  2283. procedure Screen_Set_File (Filename : in String)
  2284. is
  2285. function scr_set (f : char_array) return C_Int;
  2286. pragma Import (C, scr_set, "scr_set");
  2287. Txt : char_array (0 .. Filename'Length);
  2288. Length : size_t;
  2289. begin
  2290. To_C (Filename, Txt, Length);
  2291. if Curses_Err = scr_set (Txt) then
  2292. raise Curses_Exception;
  2293. end if;
  2294. end Screen_Set_File;
  2295. ------------------------------------------------------------------------------
  2296. procedure Resize (Win : Window := Standard_Window;
  2297. Number_Of_Lines : Line_Count;
  2298. Number_Of_Columns : Column_Count) is
  2299. function wresize (win : Window;
  2300. lines : C_Int;
  2301. columns : C_Int) return C_Int;
  2302. pragma Import (C, wresize);
  2303. begin
  2304. if wresize (Win,
  2305. C_Int (Number_Of_Lines),
  2306. C_Int (Number_Of_Columns)) = Curses_Err then
  2307. raise Curses_Exception;
  2308. end if;
  2309. end Resize;
  2310. ------------------------------------------------------------------------------
  2311. end Terminal_Interface.Curses;